home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 37
/
Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso
/
Aminet
/
util
/
rexx
/
FWCalendar.lha
/
FWCalendar
/
FWCalendar.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
2000-03-04
|
138KB
|
3,816 lines
/*
FWCalendar.rexx Macro
Creates calendars on FinalWriter v 4.x (SoftWood) & PageStream v 3.x
$VER: FWCalendar.rexx v3.82 (4 Mar 2000)
©Ron Goertz (goertz@earthlink.net)
*/
options results
signal on syntax
call AddLibraries
bguiopen = bguiopen()
if ErrorCount > 0 then call Cleanup
address value DetermineHost()
call GetSetupInfo
call SetVariables
/*************************/
/***//* Yearly Calendar */
/*************************/
if CalType == 2 then do
EventCount = 389
if App == 'FW' then VIEW 20
else if App == 'PGS' then do
if DoHide == 1 then HIDEWINDOW
else DISPLAY SCALE 25
REFRESH OFF
end
Gen$ = GeneratingY$
Do i = 1 to words(GenYVars)
InsertPos = pos('%s', Gen$)
if InsertPos == 0 then leave
Gen$ = left(Gen$, InsertPos - 1)''value(word(GenYVars, i))''substr(Gen$, InsertPos + 2)
end
Req = OpenBusy(Gen$'...', EventCount)
call MiniCalPreCalc(FYMiniCal, MiniCalWidth)
Year = EnteredYear
CalTop = Margin.Top
do r = 0 to 3
Margin.Top = CalTop + r * (7*Height.FYMiniCal + MiniCalSpacing)
do c = 0 to 2
Month = r * 3 + c + 1
Mn = right(Month, 2, '0')
TempDate = Year''Mn'01'
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
call DrawMiniCal(0, MiniCalWidth, FYMiniCal)
end
end
if DoCopyright == 1 then call RightText(PrintText(0, CalTop + 28 * Height.FYMiniCal + 3 * MiniCalSpacing, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)
call Cleanup
end
/**/
/*************************/
/***//* Monthly Calendar */
/*************************/
Year = EnteredYear
PrevMonth = Month - 1
if PrevMonth = 0 then do
PrevMonth = 12
PrevYear = Year - 1
end
else PrevYear = Year
NextMonth = Month + 1
if NextMonth = 13 then do
NextMonth = 1
NextYear = Year + 1
end
else NextYear = Year
if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
StartDST = DateInfo('I', Year'04'right(CalculateDate( 4, 'Monday', 7, ''), 2, '0'), 'S') /* First Sunday in April */
EndDST = DateInfo('I', Year'10'CalculateDate(10, 'Friday', 31, ''), 'S') /* Last Sunday in October */
end
if DoPhases ~= 0 then CountPhases = 1
if DoJulian ~= 0 then CountJulian = 1
if DoJulianLeft ~= 0 then CountJulianLeft = 1
if DoSunRise ~= 0 then CountSunRise = 1
if DoSunSet ~= 0 then CountSunSet = 1
EventCount = 40 +,
(MonthLength.Month + 5) * (1 + CountSunRise + CountSunSet + DoDateBox + CountJulian + CountJulianLeft) +,
HighlightCount * (DoBackgrounds + DoHighlights) +,
(DoExtended*2 + 8) * DoBackgrounds +,
ImageCount * DoImages +,
DoMiniCals * (MonthLength.NextMonth + MonthLength.PrevMonth + 4) +,
CountPhases * 5
if App == 'FW' then VIEW 20
else if App == 'PGS' then do
if DoHide == 1 then HIDEWINDOW
else DISPLAY SCALE 25
end
Gen$ = GeneratingM$
Do i = 1 to words(GenMVars)
InsertPos = pos('%s', Gen$)
if InsertPos == 0 then leave
Gen$ = left(Gen$, InsertPos - 1)''value(word(GenMVars, i))''substr(Gen$, InsertPos + 2)
end
Req = OpenBusy(Gen$'...', EventCount)
/************************/
/* Finally, the program */
/************************/
if App == 'PGS' then do
if DoHide == 1 then REFRESH OFF
end
TempDate = Year''Mn'01'
IDay = DateInfo('I', TempDate, 'S') - 1
interpret 'StartYear = Day.'DateInfo('W', Year'0101', 'S')
YearOffset = 7 - StartYear
if YearOffset == 7 then YearOffset = 0
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then do
LeapYear = 1
MonthLength.2 = 29
end
else LeapYear = 0
if (PrevYear//4 == 0 & PrevYear//100 > 0) | PrevYear//400 == 0 Then PrevLeapYear = 1
else PrevLeapYear = 0
interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
if (DoHighlights == 1) | (DoImages == 1) then call SetHighLights
if DoPhases ~= 0 then call GetPhases(Year, Month)
/* In PGS, no other objects should be drawn overlapping 0,0 */
PrefsString = 'FWC'TempDate''PrefsFile
if (length(PrefsString) > 31) & (App == 'FW') then do
StringCount = trunc(length(PrefsString) / 25)
NextString = 0
do i = StringCount to 0 by -1
PrintString = substr(PrefsString, (i * 25) + 1, 25)
if NextString ~= 0 then PrintString = PrintString'|'NextString'|'
NextString = PrintText(0, 0, 4pt, 'N', White$, 100, PrintString)
end
end
else call PrintText(0, 0, 4pt, 'N', White$, 100, PrefsString)
/***//* Draw dates and optional highlights */
Day = - StartDate
LineTop. = CalTop
LineBottom. = CalTop + BoxHeight*5
LineLeft. = Margin.Left
LineRight. = CalRight
BackBox. = 0
Width.WidthOfDate1 = GetFontWidth(Date, 'N', '1')
Width.WidthOfDate8 = GetFontWidth(Date, 'N', '8')
Do i = 0 to 5
if i = 5 then do
BoxTop = CalTop + BoxHeight*4.5
BHeight = BoxHeight/2
end
else do
BoxTop = CalTop + BoxHeight*i
BHeight = BoxHeight
end
Do j = 0 to 6
Day = Day + 1
JulianDay = IDay + Day
BoxLeft = Margin.Left + BoxWidth * j
/* Days for previous & next months */
If (Day < 1) | (Day > MonthLength.Month) then do
/* Previous month */
if Day < 1 then do
PrintDay = MonthLength.PrevMonth + Day
LineTop.j = CalTop + BoxHeight
LineLeft.0 = Margin.Left + BoxWidth * (j + 1)
end
/* Next month */
else do
PrintDay = Day - MonthLength.Month
interpret 'LineBottom.'j+1' = 'CalTop + BoxHeight*4
CalRow = i + 1
if LineRight.CalRow == CalRight then LineRight.CalRow = Margin.Left + BoxWidth * j
end
if DoExtended then do
if (j = Day.Sunday | j = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then do
BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
call UpdateBusy(Req, 1)
end
DayType = 'Extended'
if BackBox.JulianDay ~= 0 then TextColor = AltColor.Extended
else TextColor = Color.Extended
DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, PrintDay)
call UpdateBusy(Req, 1)
if DoDateBox == 1 then do
if BackBox.JulianDay ~= 0 then BoxColor = AltColor.Extended
else BoxColor = Color.Extended
call BoxDate(DayID, BoxColor)
call UpdateBusy(Req, 1)
end
call DoOptions
end
end
/* Days for current month */
else do
if i = 5 then do
PrevJulianDay = JulianDay - 7
call DrawLine(BoxLeft, BoxTop, BoxLeft + BoxWidth, BoxTop, 'HL', Line.Grid)
if BackBox.PrevJulianDay ~= 0 then call HalveBox(BackBox.PrevJulianDay)
call UpdateBusy(Req, 1)
end
if (j = Day.Sunday | j = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then BackBox.JulianDay = -1
/* Print Highlight */
if Highlight.Month.Day ~= '' & DoHighlights == 1 then do
if TopOption ~= 0 then Highlight.Month.Day = '//'Highlight.Month.Day
DailyHLCount = 0
SearchPos = 1
Found = 1
do until Found == 0
Found = pos('//', Highlight.Month.Day, SearchPos)
if Found > 0 then do
HighlightText = substr(Highlight.Month.Day, SearchPos, Found - SearchPos)
SearchPos = Found + 2
end
else HighlightText = substr(Highlight.Month.Day, SearchPos)
/* Draw background colors for highlight days */
if DoBackgrounds == 1 then do
if right(HighlightText, 1) == '#' then do
BoxColor = Background.HighlightH
if (BoxColor ~= White$) then TextColor = AltColor.HighlightH
else TextColor = Color.HighlightH
end
else do
BoxColor = Background.Highlight
if (BoxColor ~= White$) then TextColor = AltColor.Highlight
else TextColor = Color.Highlight
end
if (BackBox.JulianDay < 1 ) & (BoxColor ~= White$) then do
BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, BoxColor, 1)
call UpdateBusy(Req, 1)
end
end
else do
if right(HighlightText, 1) == '#' then TextColor = Color.HighlightH
else TextColor = Color.Highlight
end
Select
when Day < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
when Day < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
end
call PrintHighlight(compress(HighlightText, '#'))
call UpdateBusy(Req, 1)
DailyHLCount = DailyHLCount + 1
end
end
else do
if DoDailyColors == 1 then do
Select
when j == Day.Sunday then TextColor = Color.Sunday
when j == Day.Monday then TextColor = Color.Monday
when j == Day.Tuesday then TextColor = Color.Tuesday
when j == Day.Wednesday then TextColor = Color.Wednesday
when j == Day.Thursday then TextColor = Color.Thursday
when j == Day.Friday then TextColor = Color.Friday
when j == Day.Saturday then TextColor = Color.Saturday
end
end
else if BackBox.JulianDay ~= 0 then TextColor = AltColor.Date
else TextColor = Color.Date
end
if DoMatchColors ~= 1 then do
if DoDailyColors == 1 then do
Select
when j == Day.Sunday then TextColor = Color.Sunday
when j == Day.Monday then TextColor = Color.Monday
when j == Day.Tuesday then TextColor = Color.Tuesday
when j == Day.Wednesday then TextColor = Color.Wednesday
when j == Day.Thursday then TextColor = Color.Thursday
when j == Day.Friday then TextColor = Color.Friday
when j == Day.Saturday then TextColor = Color.Saturday
end
end
else if BackBox.JulianDay ~= 0 then TextColor = AltColor.Date
else TextColor = Color.Date
end
/* Print Day */
DayType = 'Normal'
DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, Day)
call UpdateBusy(Req, 1)
if DoDateBox == 1 then do
call BoxDate(DayID, TextColor)
call UpdateBusy(Req, 1)
end
call DoOptions
if BackBox.JulianDay == -1 then do
BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
call UpdateBusy(Req, 1)
end
end
if (i = 5) & (Day = MonthLength.Month) then leave i
end
if Day >= MonthLength.Month then leave
end
/**/
/***//* Draw grids */
LowRow = i
if LowRow = 3 then LineBottom. = CalTop + BoxHeight*4
/* Draw vertical grid */
do i = 0 to 7
LeftEdge = Margin.Left + BoxWidth*i
if DoExtended then do
if LineTop.i > CalTop then do
call DrawLine(LeftEdge, CalTop, LeftEdge, LineTop.i, 'HL', Line.Extended)
call UpdateBusy(Req, 1)
end
if LineBottom.i < LineBottom.8 then do
call DrawLine(LeftEdge, LineBottom.i, LeftEdge, LineBottom.8, 'HL', Line.Extended)
call UpdateBusy(Req, 1)
end
end
call DrawLine(LeftEdge, LineTop.i, LeftEdge, LineBottom.i, 'HL', Line.Grid)
call UpdateBusy(Req, 1)
end
/* Draw horizontal grid */
do i = 0 to min(LowRow + 1, 5)
TopEdge = CalTop + BoxHeight * i
if DoExtended then do
if LineLeft.i > Margin.Left then do
call DrawLine(Margin.Left, TopEdge, LineLeft.i, TopEdge, 'HL', Line.Extended)
call UpdateBusy(Req, 1)
end
if LineRight.i < CalRight then do
call DrawLine(LineRight.i, TopEdge, CalRight, TopEdge, 'HL', Line.Extended)
call UpdateBusy(Req, 1)
end
end
call DrawLine(LineLeft.i, TopEdge, LineRight.i, TopEdge, 'HL', Line.Grid)
call UpdateBusy(Req, 1)
end
/**/
/***//* Draw headers & minicals */
/* Create month/year header */
Text.Top = Margin.Top + ((7*Height.MiniCal) - Height.Header)/HeaderLoc
MonthID = PrintText(Margin.Left, Text.Top , Header, 'N', Color.Header, Width.Header, Month.Month' 'Year)
call UpdateBusy(Req, 1)
/* Create weekday titles */
Text.Top = CalTop - (Height.Weekday * 1.15)
Do i = 0 to 6
WeekdayID.i = PrintText(1, Text.Top, Weekday, 'N', Color.Weekday, Width.Weekday, Day.i)
call UpdateBusy(Req, 1)
End
if App == 'FW' then REDRAW
/* Position month/year header */
call CenterText(MonthID, Margin.Left + PrintWidth/2, .9 * (PrintWidth - DoMiniCals * (2 * MiniCalWidth)), 0)
call UpdateBusy(Req, 1)
/* Position weekday titles */
MaxWidth = GetMaxWidth('WeekdayID', 6)
if MaxWidth == 0 then MaxWidth = BoxWidth
Do i = 0 to 6
call CenterText(WeekdayID.i, Margin.Left + (i + .5) * BoxWidth, 0, .9 * min(1, BoxWidth/MaxWidth))
call UpdateBusy(Req, 1)
end
if DoMiniCals = 1 then do
call MiniCalPreCalc(MiniCal, MiniCalWidth)
call DrawMiniCal(-1, MiniCalWidth, MiniCal)
call DrawMiniCal(+1, MiniCalWidth, MiniCal)
end
/**/
if DoCopyright == 1 then call RightText(PrintText(0, Margin.Top + PrintHeight, 4pt, 'N', Black$, 100, CNotice), Margin.Left + PrintWidth)
if App == 'FW' then SELECTOBJECT
else if App == 'PGS' then SELECTOBJECT NONE
call Cleanup
exit
/**/
/*********************************************/
/* Subroutines */
/*********************************************/
/***//******* AddLibraries (AL) Subroutine ***********/
AddLibraries:
PortList = show('P')
ErrorCount = 0
WarningCount = 0
Req = 0
bguiopen = 0
Storage = 'RAM:FWC/'
Notice$ = 'notice'
Critical$ = 'Critical error'
See$ = 'see'
SeeOutput$ = 'see the output above for details'
ForDetails$ = 'for details'
ForwardLog$ = 'Forward log file to'
Unable$ = 'if you are unable to resolve the problem.'
ForwardContent$ = 'Forward contents of output to'
SeeShell$ = 'see the shell output for details'
OK$ = '_OK'
AL_Libs = 'rexxsupport.library rexxbgui.library bgui.library'
AL_MinVersions = ' 34.9 4.0 41.10 '
AL_Offsets = '-30 -30 -30 '
do AL_i = 1 to words(AL_Libs)
AL_Lib = word(AL_Libs, AL_i)
AL_MinVersion = word(AL_MinVersions, AL_i)
AL_Offset = word(AL_Offsets, AL_i)
if exists('LIBS:'AL_Lib) then do
AL_InstalledVersion = libver(AL_Lib)
if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == 'unknown') then do
call AddMsg('E', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
end
else if pos('rexx', AL_Lib) > 0 then call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
end
else call AddMsg('E', AL_lib' is required but could not be found.')
end
AL_Libs = 'rexxtricks.library date.library rexxmathlib.library'
AL_MinVersions = ' 0 33.310 38.1 '
AL_Offsets = '-30 -492 -30 '
AL_Variables = 'RexxTricks DateLib RexxMathLib '
do AL_i = 1 to words(AL_Libs)
AL_Lib = word(AL_Libs, AL_i)
AL_MinVersion = word(AL_MinVersions, AL_i)
AL_Offset = word(AL_Offsets, AL_i)
AL_Variable = word(AL_Variables, AL_i)
if exists('LIBS:'AL_lib) then do
AL_InstalledVersion = libver(AL_lib)
if (AL_InstalledVersion < AL_MinVersion) | (AL_InstalledVersion == '') then do
call AddMsg('W', AL_Lib' version 'AL_MinVersion' is required; your version is 'AL_InstalledVersion'.')
interpret Al_Variable' = 0'
end
else do
call addlib(AL_lib, 0, AL_Offset, trunc(AL_MinVersion))
interpret Al_Variable' = 1'
end
end
else interpret Al_Variable' = 0'
end
if (DateLib == 1) | (RexxMathLib == 1) then PhaseLib = 1
else PhaseLib = 0
if ErrorCount > 0 then call Cleanup
return
/**/
/***//******* AddMsg (AM) Subroutine ***********/
AddMsg:
parse arg AM_MsgType, AM_Msg
if AM_MsgType == 'E' then do
if symbol('ErrorCount') == 'LIT' then ErrorCount = 0
ErrorCount = ErrorCount + 1
Error.ErrorCount = AM_Msg
end
else do
if symbol('WarningCount') == 'LIT' then WarningCount = 0
WarningCount = WarningCount + 1
Warning.WarningCount = AM_Msg
end
return 0
/**/
/***//******* AssignHighlight (AH) Subroutine ***********/
AssignHighlight:
parse arg AH_Month, AH_Day, AH_Event
if upper(left(AH_Month, 9)) == 'HIGHLIGHT' then do
AH_Event = strip(substr(AH_Month, pos('=', AH_Month) + 1))
if right(AH_Event, 2) == '*/' then AH_Event = strip(left(AH_Event, lastpos('/*', AH_Event) - 1))
AH_Event = substr(AH_Event, 2, Length(AH_Event) - 2)
AH_DateString = DetermineDate1(AH_Month, AH_Day, AH_Event)
AH_Month = word(AH_DateString, 1)
AH_Day = word(AH_DateString, 2)
end
AH_DateString = DetermineDate2(AH_Month, AH_Day)
AH_Month = word(AH_DateString, 1)
AH_Day = word(AH_DateString, 2)
if Highlight.AH_Month.AH_Day == '' then Highlight.AH_Month.AH_Day = AH_Event
else Highlight.AH_Month.AH_Day = Highlight.AH_Month.AH_Day'//'AH_Event
HighlightCount = HighlightCount + 1
do AH_i = 0 to ImageClass.Count - 1
if pos(ImageClass.AH_i, upper(AH_Event)) > 0 then do
Image.AH_Month.AH_Day = AH_i
ImageCount = ImageCount + 1
leave
end
end
return 0
/**/
/***//******* AssignImage (AI) Subroutine ***********/
AssignImage:
parse arg AI_Month, AI_Day, AI_Image
if DoImages ~= 1 then return 0
if upper(left(AI_Month, 5)) == 'IMAGE' then do
AI_Image = strip(substr(AI_Month, pos('=', AI_Month) + 1))
if right(AI_Image, 2) == '*/' then AI_Image = strip(left(AI_Image, lastpos('/*', AI_Image) - 1))
AI_Image = substr(AI_Image, 2, Length(AI_Image) - 2)
AI_DateString = DetermineDate1(AI_Month, AI_Day, AI_Image)
AI_Month = word(AI_DateString, 1)
AI_Day = word(AI_DateString, 2)
end
parse var AI_Image AI_Image ',' AI_DX ',' AI_DY
if (pos('/', AI_Image) == 0) & (pos(':', AI_Image) == 0) then AI_Image = ScriptDir'Images/'AI_Image
AI_DX = strip(AI_DX);if AI_DX == '' then AI_DX = 0
AI_DY = strip(AI_DY);if AI_DY == '' then AI_DY = 0
AI_DateString = DetermineDate2(AI_Month, AI_Day)
AI_Month = word(AI_DateString, 1)
AI_Day = word(AI_DateString, 2)
if exists(AI_Image) then do
ICCount = ImageClass.Count
Image.AI_Month.AI_Day = ICCount
ImageClass.ICCount = ''
ImageFile.ICCount = AI_Image
ImageDX.ICCount = AI_DX
ImageDY.ICCount = AI_DY
ImageClass.Count = ImageClass.Count + 1
end
return 0
/**/
/***//******* BoxDate (BD) Subroutine ***********/
BoxDate:
parse arg BD_ID, BD_DateBoxColor
BD_DateBoxWidth = (DateOffset + GetWidth(BD_ID)) * 1.1
BD_DateBoxHeight = Height.Date
call DrawBox(BoxLeft, BoxTop, BD_DateBoxWidth, BD_DateBoxHeight, 'HL', BD_DateBoxColor, 0, 0, 0)
return
/**/
/***//******* CalculateDate (CD) Subroutine ***********/
CalculateDate:
/* Month is the month in which the highlight occurs */
/* HighDate is the highest (numerical) date on which the highlight will occur */
/* HighDay is the weekday on which the month starts when HighDate will occur */
/* Event is the highlight text */
parse arg CD_Month, CD_HighDay, CD_HighDate, CD_Event
if CD_Month = 13 then CD_Month = Mn - 0
if datatype(CD_HighDate) == 'CHAR' then do
CD_HighDate = upper(left(CD_HighDate, 1))
interpret 'CD_EventOffset = Day.'CD_HighDay' - StartDate'
CD_Day = 1 + CD_EventOffset
if CD_Day < 1 then CD_Day = CD_Day + 7
do until CD_Day > Monthlength.Month
CD_WN = trunc((right(DateInfo('J', Year''right(CD_Month, 2, '0')''right(CD_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
if CD_HighDate == 'A' then call AssignHighlight(CD_Month, CD_Day, CD_Event)
else if (CD_HighDate == 'E') & (CD_WN//2 == 0) then call AssignHighlight(CD_Month, CD_Day, CD_Event)
else if (CD_HighDate == 'O') & (CD_WN//2 == 1) then call AssignHighlight(CD_Month, CD_Day, CD_Event)
CD_Day = CD_Day + 7
end
end
else do
interpret 'CD_HighDay = Day.'CD_HighDay
interpret 'CD_First = Day.'DateInfo('W', Year''right(CD_Month, 2, '0')'01', 'S')
CD_Day = CD_HighDate + (CD_HighDay - CD_First)
if CD_First < CD_HighDay then CD_Day = CD_Day - 7
if CD_Event ~= '' then call AssignHighlight(CD_Month, CD_Day, CD_Event)
else return CD_Day
end
return 0
/**/
/***//******* CalculateEDate (CED) Subroutine ***********/
CalculateEDate:
/* DaysPastEaster is the number of days past Easter when the event occurs */
/* Event is the highlight text */
parse arg CED_DaysPastEaster, CED_EasterEvent
if DoEaster == 1 then do
CED_EasterEventDate = DateInfo('S', EasterSerial + CED_DaysPastEaster, 'I')
CED_EasterEventMonth = strip(substr(CED_EasterEventDate, 5, 2), 'L', '0')
CED_EasterEventDay = strip(right(CED_EasterEventDate, 2), 'L', '0')
call AssignHighlight(CED_EasterEventMonth, CED_EasterEventDay, CED_EasterEvent)
end
return 0
/**/
/***//******* CalculateImage (CI) Subroutine ***********/
CalculateImage:
/* Month is the month in which the highlight occurs */
/* HighDate is the highest (numerical) date on which the highlight will occur */
/* HighDay is the weekday on which the month starts when HighDate will occur */
/* Event is the highlight text */
parse arg CI_Month, CI_HighDay, CI_HighDate, CI_Image
if DoImages ~= 1 then return 0
if CI_Month = 13 then CI_Month = Mn - 0
if datatype(CI_HighDate) == 'CHAR' then do
CI_HighDate = upper(left(CI_HighDate, 1))
interpret 'CI_EventOffset = Day.'CI_HighDay' - StartDate'
CI_Day = 1 + CI_EventOffset
if CI_Day < 1 then CI_Day = CI_Day + 7
do until CI_Day > Monthlength.Month
CI_WN = trunc((right(DateInfo('J', Year''right(CI_Month, 2, '0')''right(CI_Day, 2, '0'), 'S'), 3) - YearOffset - 1)/7 + 1)
if CI_HighDate == 'A' then call AssignImage(CI_Month, CI_Day, CI_Image)
else if (CI_HighDate == 'E') & (CI_WN//2 == 0) then call AssignImage(CI_Month, CI_Day, CI_Image)
else if (CI_HighDate == 'O') & (CI_WN//2 == 1) then call AssignImage(CI_Month, CI_Day, CI_Image)
CI_Day = CI_Day + 7
end
end
else do
interpret 'CI_HighDay = Day.'CI_HighDay
interpret 'CI_First = Day.'DateInfo('W', Year''right(CI_Month, 2, '0')'01', 'S')
CI_Day = CI_HighDate + (CI_HighDay - CI_First)
if CI_First < CI_HighDay then CI_Day = CI_Day - 7
if CI_Event ~= '' then call AssignImage(CI_Month, CI_Day, CI_Image)
else return CI_Day
end
return 0
/**/
/***//******* CenterText (CT) Subroutine ***********/
CenterText:
parse arg CT_id, CT_CenterPoint, CT_MaxWidth, CT_WidthPercent
if App = 'FW' then do
GETOBJECTCOORDS CT_id; Parse Var result . . CT_Text.Bottom CT_Text.Width CT_Text.Height
if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
else CT_Text.Width = CT_Text.Width * CT_WidthPercent
CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
SETOBJECTCOORDS CT_id 1 CT_Text.Left CT_Text.Bottom CT_Text.Width CT_Text.Height
end
else if App == 'PGS' then do
GETTEXTOBJ POSITION CT_Text OBJECTID CT_id WINDOW winName
CT_Text.Width = CT_Text.Right - CT_Text.Left
if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
else CT_Text.Width = CT_Text.Width * CT_WidthPercent
CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
EDITTEXTOBJ POSITION CT_Text.Left CT_Text.Top (CT_Text.Left + CT_Text.Width) CT_Text.Bottom OBJECTID CT_id WINDOW winName
end
return
/**/
/***//******* CheckShanghai (CS) Subroutine ***********/
CheckShanghai:
if RexxTricks == 1 then do
if DoShanghai ~= 0 then PubScreen = AppScreen
else PubScreen = DefPubScreen
end
return
/**/
/***//******* Cleanup () Subroutine ***********/
Cleanup:
signal off syntax
call close('DataFile')
if Req ~= 0 then call bguiwinclose(Req)
if VariablesSet == 1 then do
interpret UserPrefs
if App == 'FW' then do
SELECTOBJECT
VIEW FinalView
if upper(DecimalFormat) = 'COMMA' then DOCITEMPREFS DECIMAL Comma
end
end
if App == 'PGS' then do
LOCKINTERFACE FALSE
LOADSETTINGS default
REFRESH ON
REFRESHWINDOW
DISPLAY SCALE FinalView
REVEALWINDOW ALL
end
if (ErrorCount == 0) & (CalType == 1) & (LaunchM ~= '') then interpret LaunchM
if (ErrorCount == 0) & (CalType == 2) & (LaunchY ~= '') then interpret LaunchY
LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
if LogOpen == 1 then OutType = 'File'
if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
LogOpen = 1
call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
OutType = 'CON'
end
if LogOpen == 1 then do
call writeln('FWCLog', ' Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
call writeln('FWCLog', 'Application: 'PgmVersion)
call writeln('FWCLog', 'Current Dir: 'CurrentDir)
call writeln('FWCLog', ' Script Dir: 'ScriptDir)
call writeln('FWCLog', ' Host: 'CallHost)
call writeln('FWCLog', ' Calendar: 'Calendar||'0a'x)
end
if (ErrorCount > 0) | (WarningCount > 0) then do
do i = 1 to ErrorCount
call writeln('FWCLog', Error.i)
end
do i = 1 to WarningCount
call writeln('FWCLog', Warning.i)
end
if (exists(PrefsFile)) & (word(statef(PrefsFile), 2) > 2) then do
call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
if open('DataFile', PrefsFile) then do
do until eof('DataFile')
Ln = ReadLn('DataFile')
if pos('End Pass One', Ln) > 0 then
if (SettingHighlights ~= 1) & (ListHighlightData ~= 1) then leave
call writeln('FWCLog', Ln)
end
call close('DataFile')
end
end
if (exists(ScriptDir''ChangesFile)) & (word(statef(ScriptDir''ChangesFile), 2) > 2) then do
call writeln('FWCLog', '0a'x||' -- 'ScriptDir''ChangesFile' -- ')
call open('DataFile', ScriptDir''ChangesFile)
do until eof('DataFile')
call writeln('FWCLog', ReadLn('DataFile'))
end
call close('DataFile')
end
if ErrorCount > 0 then ErrorType = Critical$
else ErrorType = Noncritical$
FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
ConCon = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
if (OutType == 'File') & (bguiopen == 0) then do
call open('CON', 'CON:10/10/500/300/FWCalendar notice/WAIT/CLOSE')
call writeln('CON', FileMsg)
call close('CON')
end
if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,PubScreen)
if (OutType == 'CON') & (bguiopen == 0) then call Writeln('FWCLog', '0a'x||ConCon)
end
else do
if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
end
address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
address command 'delete >NIL: 'Storage'FWCTemp quiet'
call close('FWCLog')
if bguiopen = 1 then call bguiclose()
exit
/**/
/***//******* ConvertJ (CJ) Subroutine ***********/
/* Routine to convert from 'J' & 'F' to normal dates obtained from the Sky & Telescope */
/* web site. The basic program from which the following was derived originally */
/* appeared in Astronomical Computing, Sky & Telescope, May, 1984 */
ConvertJ:
parse arg CJ_F, CJ_J
CJ_F = CJ_F + 0.5
if CJ_F >= 1 then do
CJ_F = CJ_F - 1
CJ_J = CJ_J + 1
end
CJ_A1 = trunc((CJ_J / 36524.25) - 51.12264)
CJ_A = CJ_J + 1 + CJ_A1 - trunc(CJ_A1 / 4)
CJ_B = CJ_A + 1524
CJ_C = trunc((CJ_B / 365.25) - 0.3343)
CJ_D = trunc(365.25 * CJ_C)
CJ_E = trunc((CJ_B - CJ_D) / 30.61)
CJ_D = CJ_B - CJ_D - trunc(30.61 * CJ_E) + CJ_F
CJ_M = CJ_E - 1
CJ_Y = CJ_C - 4716
IF CJ_E > 13.5 then CJ_M = CJ_M - 12
IF CJ_M < 2.5 then CJ_Y = CJ_Y + 1
CJ_Day = trunc(CJ_D)
return right(CJ_Y, 4, '0')' 'right(CJ_M, 2, '0')' 'right(CJ_Day, 2, '0')' 'CJ_D - CJ_Day
/**/
/***//******* ControlMX (CM) Subroutine ***********/
ControlMX:
parse arg CM_Group
pos = pos.CM_Group
do CM_i = 0 to 1
option = Option.pos
if option ~= 0 then do
do dst = 0 to GroupCount
if CM_Group = dst then iterate
interpret 'call bguiset('grp.dst',winID,'Action.CM_i','option')'
if ((Do.option == 'Julian') | (Do.option == 'JulianLeft')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveJulian == 1))) then
interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothJ')'
if Do.option = 'BothJ' then do
interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Julian')'
interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.JulianLeft')'
end
if ((Do.option == 'Sunrise') | (Do.option == 'Sunset')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveSunCalc == 1))) then
interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothS')'
if Do.option = 'BothS' then do
interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunrise')'
interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunset')'
end
end
end
interpret 'Option.'pos' = bguiget('grp.CM_Group', MX_Active)'
end
if (Do.option == 'Julian') | (Do.option == 'JulianLeft') then ActiveJulian.CM_Group = 1
else ActiveJulian.CM_Group = 0
if (Do.option == 'Sunrise') | (Do.option == 'Sunset') then ActiveSunCalc.CM_Group = 1
else ActiveSunCalc.CM_Group = 0
ActiveJulian = 0
ActiveSunCalc = 0
do grp = 0 to GroupCount
ActiveJulian = ActiveJulian + ActiveJulian.grp
ActiveSunCalc = ActiveSunCalc + ActiveSunCalc.grp
end
if ActiveJulian == 1 then
do grp = 0 to GroupCount
if ActiveJulian.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothJ')'
end
if ActiveSunCalc == 1 then
do grp = 0 to GroupCount
if ActiveSunCalc.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothS')'
end
return
/**/
/***//******* CreateDataFile (CD) Subroutine ***********/
CreateDataFile:
CD_VarCount = 0
CD_Progress = -1
if App == 'FW' then do
GETSECTIONSETUP Top Bottom Inside Outside
parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
end
else if App == 'PGS' then do
Margin.Top = 0.5
Margin.Bottom = 0.5
Margin.Left = 0.5
Margin.Right = 0.5
end
if (~exists(ScriptDir''ChangesFile)) | (word(statef(ScriptDir''ChangesFile), 2) < 2) then do
if open('DataFile', ScriptDir''ChangesFile, 'W') then do
call TranslationStrings
call open('Temp', FullCallPath)
FileOffset = 120000
call seek('Temp', FileOffset, 'B')
do until (EndPos ~= 0) | (PrevOffset = FileOffset)
PrevOffset = FileOffset
Chunk = readch('Temp', 65535)
EndPos = pos('VarList:'||'0a'x, Chunk)
if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
end
call seek('Temp', FileOffset + EndPos + 8, 'B')
DefaultVariables = readch('Temp', 65535)
call close('Temp')
call openv('DefaultVariables')
do forever
CD_VarLine = strip(readvln('DefaultVariables'))
if CD_VarLine == 'return' then leave
if CD_VarLine == '' then iterate
if left(CD_VarLine, 7) ~= 'Margin.' then interpret CD_VarLine
CD_Var = word(CD_VarLine, 1)
CD_Var.CD_VarCount = CD_Var
if (datatype(value(CD_Var.CD_VarCount)) == 'CHAR') then CD_VarLine.CD_VarCount = CD_Var.CD_VarCount" = '"Value(CD_Var.CD_VarCount)"'"
else CD_VarLine.CD_VarCount = CD_Var.CD_VarCount' = 'Value(CD_Var.CD_VarCount)
CD_VarCount = CD_VarCount + 1
end
call closev('DefaultVariables')
if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
if open('UserFile', PrefsFile) then do
UserFile = readch('UserFile', 65535)
call close('UserFile')
call openv('UserFile')
do until eofv('UserFile')
CD_Progress = -CD_Progress
call UpdateBusy(Req, CD_Progress)
CD_VarLine = strip(ReadvLn('UserFile'))
CD_VarName = upper(strip(word(CD_VarLine, 1)))
if left(CD_VarLine, 15) == '/* End Pass One' then leave
if (right(CD_VarName, 1) == '$') |,
(left(CD_VarLine, 2) == '/*') |,
(CD_VarLine == '') then iterate
CD_MemberID = MemberID(CD_VarName, 'CD_Var', CD_VarCount)
if CD_MemberID >= 0 then CD_VarLine.CD_MemberID = CD_VarLine
else do
CD_Var.CD_VarCount = CD_VarName
CD_VarLine.CD_VarCount = CD_VarLine
CD_VarCount = CD_VarCount + 1
end
end
call closev('UserFile')
end
end
call writeln('DataFile', 'Dataversion 'word(sourceline(4), 3))
call writeln('DataFile', "PrefsFile = '"PrefsFile"'")
call writeln('DataFile', "Cancel$ = '"Cancel$"'")
call writeln('DataFile', "PleaseWait$ = '"PleaseWait$"'")
call writeln('DataFile', "PrepReq$ = '"PrepReq$"'")
do CD_i = 0 to CD_VarCount - 1
call writeln('DataFile', CD_VarLine.CD_i)
end
call close('DataFile')
if sign(CD_Progress) == 1 then call UpdateBusy(Req, -CD_Progress)
end
else do
call AddMsg('E', 'Unable to create 'ScriptDir''ChangesFile)
call Cleanup
end
end
return
/**/
/***//******* DateInfo (PROCEDURE) Subroutine ***********/
DateInfo: PROCEDURE
/* DateInfo('I', '19780101', 'S') = 2443510 */
/* Date('I', '19780101', 'S') = 0 */
/* Option 'C' returns days since Jan 1, xx00 */
parse arg Option, Date, Format
if Option == '' then Option = 'N'
if Date == '' then do
Date = Date('S')
Format = 'S'
end
Option = upper(left(Option, 1))
Format = upper(left(Format, 1))
if (Format == 'I') | (Format = '') then do
Format = 'I'
/* Routine to convert from a serial date to year/month/day obtained from the */
/* Sky & Telescope web site. The basic program from which the following was */
/* derived originally appeared in Astronomical Computing, Sky & Telescope,May, 1984 */
A1 = trunc((Date / 36524.25) - 51.12264)
A = Date + 1 + A1 - trunc(A1 / 4)
B = A + 1524
C = trunc((B / 365.25) - 0.3343)
D = trunc(365.25 * C)
E = trunc((B - D) / 30.61)
D = B - D - trunc(30.61 * E)
Month = E - 1
Year = C - 4716
IF E > 13.5 then Month = Month - 12
IF Month < 2.5 then Year = Year + 1
Day = trunc(D)
J = Date
end
else do
Year = left(Date, 4) - 0
Month = substr(Date, 5, 2) - 0
Day = right(Date, 2) - 0
/* The following two lines are modified from PerpetualCalendar.bas that */
/* appeared in Astronomical Computing, Sky & Telescope, July, 1985 */
Temp = 0; if Month <= 2 then Temp = -1
J = 367*Year-trunc(7*(Year+trunc((Month + 9)/12))/4)+trunc(275*Month/9)+1721031-trunc(3*(trunc((Year+Temp)/100)+1)/4) + Day - 2
end
select
when Option == 'B' then do
return J - 1721060
end
when Option == 'C' then do
return J + 2 - DateInfo('I', left(right(Year, 4, '0'), 2)'000101', 'S')
end
when (Option == 'D') | (Option == 'J') then do
DayCount = 0
MonthLength.1 = 31
MonthLength.2 = 28
MonthLength.3 = 31
MonthLength.4 = 30
MonthLength.5 = 31
MonthLength.6 = 30
MonthLength.7 = 31
MonthLength.8 = 31
MonthLength.9 = 30
MonthLength.10 = 31
MonthLength.11 = 30
MonthLength.12 = 31
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
do I = (Month - 1) to 1 by -1
DayCount = DayCount + MonthLength.I
end
if Option == 'D' then return DayCount + Day
else return right(Year, 2)''right(DayCount + Day, 3, '0')
end
when Option == 'E' then do
return right(Day, 2, '0')'/'right(Month, 2, '0')'/'right(Year, 2, '0')
end
when Option == 'I' then return J
when (Option == 'M') | (Option == 'N') then do
Select
when Month == 1 then Month = 'January'
when Month == 2 then Month = 'February'
when Month == 3 then Month = 'March'
when Month == 4 then Month = 'April'
when Month == 5 then Month = 'May'
when Month == 6 then Month = 'June'
when Month == 7 then Month = 'July'
when Month == 8 then Month = 'August'
when Month == 9 then Month = 'September'
when Month == 10 then Month = 'October'
when Month == 11 then Month = 'November'
when Month == 12 then Month = 'December'
end
if Option == 'M' then return Month
else return right(Day, 2, '0')' 'left(Month, 3)' 'Year
end
when Option == 'O' then return right(Year, 2, '0')'/'right(Month, 2, '0')'/'right(Day, 2, '0')
when Option == 'S' then return right(Year, 4, '0')''right(Month, 2, '0')''right(Day, 2, '0')
when Option == 'U' then return right(Month, 2, '0')'/'right(Day, 2, '0')'/'right(Year, 2, '0')
when Option == 'W' then do
J = J + 1
Weekday = J - 7 * trunc(J / 7)
Select
when Weekday == 0 then return 'Sunday'
when Weekday == 1 then return 'Monday'
when Weekday == 2 then return 'Tuesday'
when Weekday == 3 then return 'Wednesday'
when Weekday == 4 then return 'Thursday'
when Weekday == 5 then return 'Friday'
when Weekday == 6 then return 'Saturday'
end
end
otherwise return 0
end
/**/
/***//******* DetermineDate1 (DD1) Subroutine ***********/
DetermineDate1:
parse arg DD1_Month, DD1_Day, DD1_Event
DD1_Ln = DD1_Month
DD1_Month = pos('.', DD1_Ln) + 1
DD1_Day = pos('.', DD1_Ln, DD1_Month) + 1
DD1_Event = pos('=', DD1_Ln) + 1
DD1_Month = substr(DD1_Ln, DD1_Month, DD1_Day - DD1_Month - 1)
if DD1_Month == '13' then DD1_Month = Mn - 0
DD1_Day = upper(strip(substr(DD1_Ln, DD1_Day, DD1_Event - DD1_Day - 1)))
if left(DD1_Day, 2) = '32' then DD1_Day = overlay(MonthLength.DD1_Month, DD1_Day)
return DD1_Month' 'DD1_Day
/**/
/***//******* DetermineDate2 (DD2) Subroutine ***********/
DetermineDate2:
parse arg DD2_Month, DD2_Day
DD2_DateString = Year''right(DD2_Month, 2, '0')''right(strip(DD2_Day, 'T', 'PN'), 2, '0')
DD2_Weekday = DateInfo('W', DD2_DateString, 'S')
if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Saturday') then do
DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 2), 'I')
DD2_Month = substr(DD2_NewDay, 5, 2) - 0
DD2_Day = substr(DD2_NewDay, 7, 2) - 0
end
else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Saturday') then do
DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 1), 'I')
DD2_Month = substr(DD2_NewDay, 5, 2) - 0
DD2_Day = substr(DD2_NewDay, 7, 2) - 0
end
else if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Sunday') then do
DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 1), 'I')
DD2_Month = substr(DD2_NewDay, 5, 2) - 0
DD2_Day = substr(DD2_NewDay, 7, 2) - 0
end
else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Sunday') then do
DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 2), 'I')
DD2_Month = substr(DD2_NewDay, 5, 2) - 0
DD2_Day = substr(DD2_NewDay, 7, 2) - 0
end
DD2_Day = strip(DD2_Day, 'T', 'PN')
return DD2_Month' 'DD2_Day
/**/
/***//******* DetermineHost () Subroutine ***********/
DetermineHost:
parse source . . . FullCallPath . CallHost
CallHost = strip(CallHost)
ScriptDir = PathPart(FullCallPath)
CurrentDir = upper(Pragma('D'))
if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
owner = ReadEnv('Owner')
if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
App = 'FW'
AppName = 'FINALWRITER'
if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
else HostPort = CallHost
address value HostPort
if owner == 'rgoertz' then do
if CallHost == 'REXX' then CLEARDOC FORCE
else do
CLEARDOC
if result == 1 then exit
end
end
else do
CLEARDOC
if result == 1 then exit
end
GETDOCITEMPREFS Decimal; DecimalFormat = result
DOCITEMPREFS Decimal Period
end
else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
App = 'PGS'
AppName = 'PAGESTREAM'
HostPort = 'PAGESTREAM'
end
else do
call AddMsg('E', 'Unable to determine host!')
call Cleanup
end
AppScreen = ''
DefPubScreen = ''
if RexxTricks == 1 then do
if (pubscreenlist('ScreenList') > 0) then do
do i = 1 to ScreenList.0
if pos(AppName, upper(ScreenList.i)) > 0 then do
AppScreen = ScreenList.i
leave
end
end
end
end
return HostPort
/**/
/***//******* DoOptions (DO) Subroutine ***********/
DoOptions:
DO_PrevDay = Day - 7
if (DayType == 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Extended
else if (DayType == 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Extended
/***//* DoJulian & DoJulianLeft */
if (DoJulian ~= 0) | (DoJulianLeft ~= 0) then do
DO_JDay = right(DateInfo('J', JulianDay, 'I'), 3)
if (Day <= 0) & (PrevMonth = 12) then DO_JDayLeft = right(365 + PrevLeapYear - DO_JDay, 3, '0')
else DO_JDayLeft = right(365 + LeapYear - DO_JDay, 3, '0')
if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Julian
else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Julian
if DoJulian ~= 0 then do
DO_Text2Print = Text.Julian''DO_JDay
if DoJulianLeft == DoJulian then DO_Text2Print = DO_Text2Print'/'DO_JDayLeft
call UpdateBusy(Req, 1)
JID.Day = PrintOption(DoJulian)
if (i = 5) & (left(DoJulian, 1) ~= 'T') then call Move(JID.DO_PrevDay, 0, -BoxHeight / 2)
end
if (DoJulianLeft ~= 0) & (DoJulianLeft ~= DoJulian) then do
DO_Text2Print = DO_JDayLeft
call UpdateBusy(Req, 1)
JIDL.Day = PrintOption(DoJulianLeft)
if (i = 5) & (left(DoJulianLeft, 1) ~= 'T') then call Move(JIDL.DO_PrevDay, 0, -BoxHeight / 2)
end
end
/**/
/***//* DoSunrise & DoSunset */
if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
SRSS$ = GetSRSS(JulianDay)
if DoSunRise ~= 0 then do
if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunrise
else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunrise
DO_Text2Print = Text.Sunrise''word(SRSS$, 1)
if DoSunSet == DoSunRise then DO_Text2Print = DO_Text2Print'/'word(SRSS$, 3)
call UpdateBusy(Req, 1)
SRID.Day = PrintOption(DoSunRise)
if (i = 5) & (left(DoSunRise, 1) ~= 'T') then call Move(SRID.DO_PrevDay, 0, -BoxHeight / 2)
end
if (DoSunSet ~= 0) & (DoSunSet ~= DoSunRise) then do
if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunset
else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunset
DO_Text2Print = Text.Sunset''word(SRSS$, 3)
call UpdateBusy(Req, 1)
SSID.Day = PrintOption(DoSunSet)
if (i = 5) & (left(DoSunSet, 1) ~= 'T') then call Move(SSID.DO_PrevDay, 0, -BoxHeight / 2)
end
end
/**/
/***//* DoWeekNumber */
if (DoWeekNumber ~= 0) & (j = 0) then do
if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.WeekNumber
else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.WeekNumber
DO_WN = trunc((right(DateInfo('J', JulianDay, 'I'), 3) - YearOffset - 1)/7 + 1)
DO_Text2Print = Text.WeekNumber''DO_WN
call UpdateBusy(Req, 1)
WNID.Day = PrintOption(DoWeekNumber)
if (i = 5) & (left(DoWeekNumber, 1) ~= 'T') then call Move(WNID.DO_PrevDay, 0, -BoxHeight / 2)
end
/**/
/***//* DoImages */
if DoImages == 1 then do
if Image.Month.Day ~= '' then do
ImageNumber = Image.Month.Day
ImageDX = ImageDX.ImageNumber
ImageDY = ImageDY.ImageNumber
if ImageType.ImageNumber == '' then do
DO_Cmd = Storage''GfxApp' >ENV:FWCTemp '
DO_InsertPos = pos('%s', GfxCmd)
DO_Cmd = DO_Cmd''left(GfxCmd, DO_InsertPos - 1)''ImageFile.ImageNumber''substr(GfxCmd, DO_InsertPos + 2)
address command DO_Cmd
DO_Template = GfxTemplate
DO_InfoLine = ReadEnv('FWCTemp')
if DO_InfoLine ~= '' then do
interpret "parse var DO_InfoLine "DO_Template
DO_ImageType = upper(strip(ImgDT))
DO_Width = strip(ImgWidth)
DO_Height = strip(ImgHeight)
if (datatype(DO_ImageType) ~= 'CHAR') | (datatype(DO_Width) ~= 'NUM') | (datatype(DO_Height) ~= 'NUM') then do
call AddMsg('W', DO_InfoLine)
Image.Month.Day = ''
end
else do
ImageType.ImageNumber = DO_ImageType
if DO_ImageType ~= 'POST' then do
ImageWidth.ImageNumber = DO_Width / 72
ImageHeight.ImageNumber = DO_Height / 72
if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
ImageWidth.ImageNumber = ImageWidth.ImageNumber / EnlFactor
ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
end
end
end
end
end
call UpdateBusy(Req, 1)
if ImageType.ImageNumber ~= '' then do
if App == 'FW' then do
if ImageWidth.ImageNumber == 0 then do
INSERTIMAGE ImageFile.ImageNumber POSITION 1 '-1' '-1' '-1' '-1'
ImageID.Day = result
GETOBJECTCOORDS ImageID.Day
parse var result . . . ImageWidth.ImageNumber ImageHeight.ImageNumber
if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
ImageWidth.ImageNumber = ImageWidth.ImageNumber / EnlFactor
ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
end
DELETEOBJECT ImageID.Day
end
Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
Image.Top = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
INSERTIMAGE ImageFile.ImageNumber POSITION 1 Image.Left Image.Top ImageWidth.ImageNumber ImageHeight.ImageNumber
ImageID.Day = result
OBJECTTOBACK ImageID.Day
if BackBox.JulianDay ~= 0 then OBJECTTOBACK BackBox.JulianDay
end
else if App == 'PGS' then do
DO_ImgType = ImageType.ImageNumber
if PGSFilter.DO_ImgType == '' then PGSFilter.DO_ImgType = DO_ImgType
if ImageWidth.ImageNumber == 0 then do
PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType WINDOW winName
ImageID.Day = result
if ImageType.ImageNumber == 'POST' then GETDRAWING POSITION Image OBJECTID ImageID.Day WINDOW winName
else GETPICTURE POSITION Image OBJECTID ImageID.Day WINDOW winName
DELETEOBJECT OBJECTID ImageID.Day WINDOW winName
ImageWidth.ImageNumber = Image.Right - Image.Left
ImageHeight.ImageNumber = Image.Bottom - Image.Top
if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
ImageWidth.ImageNumber = ImageWidth.ImageNumber / EnlFactor
ImageHeight.ImageNumber = ImageHeight.ImageNumber / EnlFactor
end
end
Image.Left = BoxLeft + (BoxWidth - ImageWidth.ImageNumber)/2 + ImageDX
Image.Top = BoxTop + (BHeight - ImageHeight.ImageNumber)/2 + ImageDY
PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType AT Image.Left Image.Top WINDOW winName
ImageID.Day = result
if ImageType.ImageNumber == 'POST' then EDITDRAWING POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
else EDITPICTURE POSITION Image.Left Image.Top (Image.Left + ImageWidth.ImageNumber) (Image.Top + ImageHeight.ImageNumber) OBJECTID ImageID.Day WINDOW winName
SENDTOBACK OBJECTID ImageID.Day WINDOW winName
if BackBox.JulianDay ~= 0 then SENDTOBACK OBJECTID BackBox.JulianDay WINDOW winName
end
end
end
if (i = 5) & (Image.Month.DO_PrevDay ~= '') then do
ImageNumber = Image.Month.DO_PrevDay
if (ImageWidth.ImageNumber > (BoxWidth * MaxImgWidth)) | (ImageHeight.ImageNumber > (BHeight * MaxImgHeight)) then do
EnlFactor = max(ImageWidth.ImageNumber / (BoxWidth * MaxImgWidth), ImageHeight.ImageNumber / (BHeight * MaxImgHeight))
Image.Width = ImageWidth.ImageNumber/EnlFactor
Image.Height = ImageHeight.ImageNumber/EnlFactor
end
else do
Image.Width = ImageWidth.ImageNumber
Image.Height = ImageHeight.ImageNumber
end
Image.Left = BoxLeft + (BoxWidth - Image.Width)/2
Image.Top = BoxTop - BHeight + (BHeight - Image.Height)/2
if App == 'FW' then do
SETOBJECTCOORDS ImageID.DO_PrevDay 1 Image.Left Image.Top Image.Width Image.Height
OBJECTTOBACK ImageID.DO_PrevDay
end
else if App == 'PGS' then do
if ImageType.ImageNumber == 'POST' then EDITDRAWING POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) ADJUST SCALECONTENT OBJECTID ImageID.DO_PrevDay WINDOW winName
else EDITPICTURE POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) OBJECTID ImageID.DO_PrevDay WINDOW winName
SENDTOBACK OBJECTID ImageID.DO_PrevDay WINDOW winName
end
end
end
/**/
/***//* DoPhases */
if Day < 1 then do
DO_PrintColor = Color.Extended
DO_MoonDay = PrintDay
DO_MoonMonth = PrevMonth
DO_MoonYear = PrevYear
end
else if Day > MonthLength.Month then do
DO_PrintColor = Color.Extended
DO_MoonDay = PrintDay
DO_MoonMonth = NextMonth
DO_MoonYear = NextYear
end
else do
DO_PrintColor = Color.Moon
DO_MoonDay = Day
DO_MoonMonth = Month
DO_MoonYear = EnteredYear
end
if (DoPhases ~= 0) & (MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay ~= '') then do
select
when right(DoPhases, 1) == 'L' then DO_MoonLeft = BoxLeft + (MoonRadius * 1.2)
when right(DoPhases, 1) == 'C' then DO_MoonLeft = BoxLeft + BoxWidth / 2
when right(DoPhases, 1) == 'R' then DO_MoonLeft = BoxLeft + BoxWidth - (MoonRadius * 1.2)
end
if left(DoPhases, 1) == 'T' then DO_DX = MoonRadius * 1.2
else if left(DoPhases, 1) == 'B' then DO_DX = BHeight - (MoonRadius * 1.2)
MoonID.Day = DrawMoon(MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay, DO_MoonLeft, BoxTop + DO_DX, DO_PrintColor)
if left(DoPhases, 1) == 'T' then MoonID.Day = 0
call UpdateBusy(Req, 1)
end
if (i = 5) & (MoonPhase.EnteredYear.Month.DO_PrevDay ~= '') then call Move(MoonID.DO_PrevDay, 0, -BoxHeight / 2)
/**/
return
/**/
/***//******* DoSetupReq () Subroutine ***********/
DoSetupReq:
ActiveJulian = 0
ActiveJulian. = 0
ActiveSunCalc = 0
ActiveSunCalc. = 0
Option. = 0
do opt = 1 + (PhaseLib ~= 1) to 5 + 3 * exists(Storage'suncalc')
interpret 'DoValue = Do'Do.opt
if (DoValue ~= 0) & (length(DoValue) == 1) then DoValue = 'B'DoValue
interpret 'posn = Option.'opt
if ((DoValue == 0) | (symbol(DoValue) == 'LIT')) & (posn == 0) then interpret 'Option.'DoValue' = MXPos.'Do.opt
end
do i = 0 to 4
grp = pos.i
option = Option.grp
if (Do.option == 'Sunset') & (DoSunrise == DoSunset) then interpret 'Option.'pos.i' = 'MXPos.BothS
else if (Do.option == 'JulianLeft') & (DoJulian == DoJulianLeft) then interpret 'Option.'pos.i' = 'MXPos.BothJ
end
call bguilist('monthlist_',January$,February$,March$,April$,May$,June$,July$,August$,September$,October$,November$,December$)
call bguilist('mxopts_',None$,Phases$,Weeknumber$,Julian$,JulLeft$,JulJulLeft$,Sunrise$,Sunset$,RiseSet$)
call UpdateBusy(Req, 1)
g=bguivgroup(,
bguiinfo('dummy_',,esc||'c'PrefsName)bguilayout(LGO_FixMinHeight, 1)||,
bguimx('mainswitcher_',,bguilist('mainpnames_',OptLayout$,Variables$,Top$,Bottom$),'T')bguilayout(LGO_FixMinHeight,1)||,
bguipages('mainpages_',,
bguivgroup(,
bguihgroup(,
bguivgroup(,
bguicheckbox('minicals_',MiniCals$, DoMiniCals)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('highlights_',Highlights$, DoHighlights)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('extended_',Extended$, DoExtended)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
)||,
bguivarspace(10)||,
bguivgroup(,
bguicheckbox('dateboxes_',BoxDates$, DoDateBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('backgrounds_',Backgrounds$, DoBackgrounds)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguicheckbox('images_',Images$, DoImages)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
),
,-2,'F',Options$)||,
bguivgroup(,
bguihgroup(,
bguivarspace(40)||,
bguistring('topmargin_',,Margin.Top,8)bguilayout(LGO_FixMinHeight, 1)bguilayout(LGO_Weight,20)||,
bguivarspace(40),
)||,
bguihgroup(,
bguivarspace(20)||,
bguistring('leftmargin_',,Margin.Left,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguicycle('orientation_',,bguilist('orientlist_',Wide$,Tall$))bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguistring('rightmargin_',,Margin.Right,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguivarspace(20),
)||,
bguihgroup(,
bguivarspace(40)||,
bguistring('bottommargin_',,Margin.Bottom,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
bguivarspace(40),
),
,-2,'F',OrientMarg$),
)||,
bguivgroup(,
bguihgroup(,
bguicycle('fontvar_',,'FontName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguistring('fontvalue_',,value(FontName),256)bguilayout(LGO_FixMinHeight,1)||,
bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
,-2,'F',Fonts$)||,
bguivgroup(,
bguihgroup(,
bguicycle('colorvar_',,'ColorName')bguilayout(LGO_FixMinHeight, 1)||,
bguicycle('colorlist_',,'ColorList')bguilayout(LGO_FixMinHeight, 1),
)||,
bguihgroup(,
bguivarspace(1)||,
bguicheckbox('matchcolors_',MatchColors$, DoMatchColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
)||,
bguihgroup(,
bguivarspace(1)||,
bguicheckbox('dailycolors_',DailyColors$, DoDailyColors)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
),
,-2,'F',Colors$)||,
bguihgroup(,
bguicycle('currentvar_',,'VarName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
bguistring('currentvalue_',,VarVal,256)bguilayout(LGO_FixMinHeight,1),
,-2,'F',MiscVar$),
,-2)||,
bguihgroup(,
bguivarspace(40)||,
bguivgroup(,
bguimx('topcenter_',Top$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F')||,
bguivgroup(,
bguimx('topright_',Top$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F'),
)||,
bguihgroup(,
bguivgroup(,
bguimx('bottomleft_',Bottom$||'0a'x||Left$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F')||,
bguivgroup(,
bguimx('bottomcenter_',Bottom$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F')||,
bguivgroup(,
bguimx('bottomright_',Bottom$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
,-3,'F'),
),
)||,
bguihgroup(,
bguicycle('monthchoice_',,'monthlist_')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguistring('yearchoice_',,Year,5)bguilayout(LGO_FixMinHeight, 1),
)||,
bguihgroup(,
bguibutton('monthly_',Monthly$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguibutton('yearly_',WholeYear$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguivarspace(2)||,
bguibutton('reset_',Reset$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguibutton('load_',Load$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguibutton('export_',Export$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
bguivarspace(2)||,
bguibutton('cancel_',Cancel$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
),
,'-3','-3')
call UpdateBusy(Req, 1)
winID=bguiwindow(VarGUITitle$,g,0,0,,PubScreen)
if App == 'PGS' then do
FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
call UpdateBusy(Req, 1)
FontwinID=bguiwindow(SelectFont$,FontGroup,20,50,,PubScreen)
end
ExportwinID = bguiwindow('',bguivgroup(bguiinfo('dummy_',,esc''Exporting$'...')),0,0,,PubScreen)
do i = 0 to GroupCount
interpret 'call bguiset('grp.i',winID,MX_Active,Option.'pos.i')'
call ControlMX(i)
if PhaseLib ~= 1 then interpret 'call bguiset('grp.i',winID,MX_DisableButton,1)'
if ~exists(Storage'suncalc') then interpret 'call bguiset('grp.i',winID,MX_DisableButton,6,MX_DisableButton,7,MX_DisableButton,8)'
end
call bguiset(obj.orientation_,winID,CYC_Active,OrientChoice)
call bguiset(obj.monthchoice_,winID,CYC_Active,CalMonth-1)
call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(ColorName),'ColorList')))
CurrentColor = bguiget(obj.colorlist_, CYC_Active)
call bguiset(obj.currentvar_,,BT_Key,'09'x)
call bguiset(obj.currentvalue_,,BT_Key,'0d'x)
call bguiset(obj.images_,winID,GA_Disabled,~exists(Storage''GfxApp))
call bguiaddmap(obj.mainswitcher_,obj.mainpages_,MX_Active,PAGE_Active)
call bguiwintabcycleorder(winID,obj.topmargin_||obj.leftmargin_||obj.rightmargin_||obj.bottommargin_)
if bguiwinopen(winID)=0 then bguierror(12)
if Req ~= 0 then call bguiwinclose(Req)
CalType = 0
Reset = 0
do while 1
call bguiwinwaitevent(winID,'ID')
select
when (id == id.cancel_) | (id == id.winclose) then do
call bguiwinclose(winID)
call Cleanup
end
when id == id.reset_ then do
Reset = 1
address command 'delete >NIL: 'ScriptDir''ChangesFile' quiet'
PrefsFile = 'Default'
leave
end
when id == id.load_ then do
CurrentPrefs = PrefsFile
PrefsFile = bguifilereq(ScriptDir''"FWCalendar.prefs", SelectFile$, winID,DOPATTERNS,PatVar)
if PrefsFile ~= '' then do
if ~exists(PrefsFile) then do
call bguireq(PrefsFile' 'CantFind$'...','*'OK$,'FWCalendar 'Notice$,winID)
PrefsFile = CurrentPrefs
end
else do
address command 'delete >NIL: 'ScriptDir''ChangesFile' quiet'
Reset = 1
leave
end
end
end
when id == id.export_ then do
ExportFile = ''
ExportFile = bguifilereq(ScriptDir, ExportFile$, winID)
if ExportFile ~= '' then do
if upper(NameOnly(ExportFile)) == upper(NameOnly(PrefsFile)) then call bguireq(esc'c'CantMatch$'...','*'OK$,'FWCalendar 'Notice$,winID)
else if open('ExportFile', ExportFile, 'W') then do
call bguiwinbusy(winID)
call bguiwinopen(ExportwinID)
call ExportVariables('ExportFile')
call bguiwinclose(ExportwinID)
call bguiwinready(winID)
call close('ExportFile')
end
else call bguireq(ExportFile' 'CantOpen$'...','*'OK$,'FWCalendar 'Notice$,winID)
end
end
when id == id.minicals_ then DoMiniCals = sign(bguiget(obj.minicals_, GA_Selected))
when id == id.highlights_ then DoHighlights = sign(bguiget(obj.highlights_, GA_Selected))
when id == id.extended_ then DoExtended = sign(bguiget(obj.extended_, GA_Selected))
when id == id.dateboxes_ then DoDateBox = sign(bguiget(obj.dateboxes_, GA_Selected))
when id == id.backgrounds_ then DoBackgrounds = sign(bguiget(obj.backgrounds_, GA_Selected))
when id == id.images_ then DoImages = sign(bguiget(obj.images_, GA_Selected))
when id == id.matchcolors_ then DoMatchColors = sign(bguiget(obj.matchcolors_, GA_Selected))
when id == id.dailycolors_ then DoDailyColors = sign(bguiget(obj.dailycolors_, GA_Selected))
when id == id.topmargin_ then Margin.Top = bguiget(obj.topmargin_, STRINGA_TextVal)
when id == id.leftmargin_ then Margin.Left = bguiget(obj.leftmargin_, STRINGA_TextVal)
when id == id.rightmargin_ then Margin.Right = bguiget(obj.rightmargin_, STRINGA_TextVal)
when id == id.bottommargin_ then Margin.Bottom = bguiget(obj.bottommargin_, STRINGA_TextVal)
when id == id.orientation_ then do
if bguiget(obj.orientation_,CYC_Active) == 0 then Orientation = 'Wide'
else Orientation = 'Tall'
end
when id == id.fontvalue_ then do
call bguireq('1b'x||"c"MustUse$,"*"OK$,'',winID)
call bguiset(obj.fontvalue_, winID,STRINGA_TextVal, value(FontName))
end
when id == id.addfont_ then do
if App == 'FW' then do
FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$, winID,,'#?')
if FontFile ~= '' then call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,FontFile)
end
else if App == 'PGS' then do
call bguiwinbusy(winID)
call bguiwinopen(FontwinID)
do while 1
call bguiwinwaitevent(FontwinID,'ID')
if id = id.winclose then leave
if id = id.fontlistview_ then do
call bguiset(obj.fontvalue_, winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
leave
end
end
call bguiwinclose(FontwinID)
call bguiwinready(winID)
end
end
when id == id.fontvar_ then do
interpret FontName" = '"strip(bguiget(obj.fontvalue_, STRINGA_TextVal),'B', "'"||'"')"'"
FontName = value('FontName.'bguiget(obj.fontvar_, CYC_Active))
call bguiset(obj.fontvalue_,winID,STRINGA_TextVal,Value(FontName))
end
when id == id.colorvar_ then do
interpret ColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
ColorName = value('ColorName.'bguiget(obj.colorvar_, CYC_Active))
call bguiset(obj.colorlist_,winID,CYC_Active,max(0, MemberID(Value(ColorName),'ColorList')))
CurrentColor = bguiget(obj.colorlist_, CYC_Active)
end
when id == id.colorlist_ then do
if (pos('BACKGROUND.', upper(ColorName)) == 0) & (bguiget(obj.colorlist_, CYC_Active) == ColorList.Count - 1) then do
call bguireq('1b'x||"c"NotClear$,"*"OK$,'',winID)
call bguiset(obj.colorlist_, winID, CYC_Active, CurrentColor)
end
end
when id == id.currentvar_ then do
Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
if datatype(Value) == 'CHAR' then Value = "'"strip(Value,'B', "'"||'"')"'"
if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
interpret 'ImageFile.'IC' = 'Value
end
else interpret Varname' = 'Value
VarName = value('VarName.'bguiget(obj.currentvar_, CYC_Active))
if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,value('ImageFile.IC'))
end
else call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,Value(VarName))
end
when id == id.monthly_ then do
CalType = 1
EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
Month = bguiget(obj.monthchoice_, CYC_Active) + 1
end
when id == id.yearly_ then do
CalType = 2
EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
leave
end
when id == id.bottomleft_ then call ControlMX(0)
when id == id.bottomcenter_ then call ControlMX(1)
when id == id.bottomright_ then call ControlMX(2)
when id == id.topcenter_ then call ControlMX(3)
when id == id.topright_ then call ControlMX(4)
otherwise nop
end
if CalType ~= 0 then leave
end
interpret FontName" = '"strip(bguiget(obj.fontvalue_, STRINGA_TextVal),'B', "'"||'"')"'"
interpret ColorName' = "'value('ColorList.'bguiget(obj.colorlist_, CYC_Active))'"'
Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
if datatype(Value) == 'CHAR' then do
Value = strip(Value,'B', "'"||'"')
if pos("'", Value) ~= 0 then Value = '"'Value'"'
else Value = "'"Value"'"
end
if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
interpret 'ImageFile.'IC' = 'Value
end
else interpret Varname' = 'Value
return
/**/
/***//******* DrawBox (DB) Subroutine ***********/
DrawBox:
parse arg DB_x1, DB_y1, DB_width, DB_height, DB_Weight, DB_LineColor, DB_FillBool, DB_FillColor, DB_SendToBack
if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
if App == 'FW' then do
if DB_Weight == 'HL' then DB_Weight = 'Hairline'
else if DB_Weight == 0 then do
DB_Weight = 'None'
if DB_FillColor ~= '<'Clear$'>' then DB_LineColor = DB_FillColor
end
if DB_FillBool == 1 then DB_FillBool = 'Solid'
else do
DB_FillBool = 'Transparent'
DB_FillColor = DB_LineColor
end
BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_LineColor'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
DRAWBOX 1 DB_x1 DB_y1 DB_width DB_height; DB_id = result
if DB_SendToBack == 1 then OBJECTTOBACK
end
else if App == 'PGS' then do
if DB_Weight == 'HL' then DB_Weight = 0.3pt
else DB_Weight = DB_Weight'pt'
if DB_FillBool == 1 then DB_FillBool = 'ON'
else DB_FillBool = 'OFF'
If DB_Weight == 0 then DB_LineBool = 'OFF'
else DB_LineBool = 'ON'
DRAWBOX DB_x1 DB_y1 DB_x1+DB_width DB_y1+DB_height WINDOW winName; DB_id = result
STROKED DB_LineBool OBJECT WINDOW winName
SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECT WINDOW winName
SETCOLORSTYLE '"'DB_LineColor'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
FILLED DB_FillBool OBJECT WINDOW winName
SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECT WINDOW winName
if DB_SendToBack == 1 then SENDTOBACK OBJECTID DB_id WINDOW winName
end
return DB_id
/**/
/***//******* DrawHalf (DH) Subroutine ***********/
DrawHalf:
parse arg DH_Side
if App == 'FW' then do
if DH_Side == 'L' then DH_sign = -1
else DH_sign = 1
STARTPATH 1 DM_CtrX (DM_CtrY + MoonRadius)
CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY + MoonRadius) (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY + MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius)) DM_CtrY
CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY - MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY - MoonRadius) DM_CtrX (DM_CtrY - MoonRadius)
ENDPATH Close
end
else if App == 'PGS' then do
if DH_Side == 'L' then DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
else DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
end
return result
/**/
/***//******* DrawLine (DL) Subroutine ***********/
DrawLine:
parse arg DL_x1, DL_y1, DL_x2, DL_y2, DL_Weight, DL_Color
if App == 'FW' then do
if DL_Weight == 'HL' then DL_Weight = 'Hairline'
else if DL_Weight == 0 then DL_Weight = 'None'
LINEPREFS LINEWT DL_Weight LINECOLOR '"'DL_Color'"'
DRAWLINE 1 DL_x1 DL_y1 DL_x2 DL_y2
end
else if App == 'PGS' then do
if DL_Weight == 'HL' then DL_Weight = '0.3pt'
else DL_Weight = DL_Weight'pt'
DRAWLINE DL_x1 DL_y1 DL_x2 DL_y2 WINDOW winName
STROKED ON OBJECT WINDOW winName
SETSTROKEWEIGHT DL_Weight STROKENUMBER 0 OBJECT
SETCOLORSTYLE '"'DL_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
end
return
/**/
/***//******* DrawMiniCal (DMC) Subroutine ***********/
DrawMiniCal:
parse arg DMC_MiniDirection, DMC_CalWidth, DMC_FontType
DMC_ColumnWidth = DMC_CalWidth/8
DMC_BoxCount = 0
DMC_MiniMonth = Month + DMC_MiniDirection
if DMC_MiniMonth == 0 | DMC_MiniMonth == 13 then do
DMC_MiniMonth = abs(DMC_MiniMonth - 12)
Year = EnteredYear + DMC_MiniDirection
end
else Year = EnteredYear
Mn = right(DMC_MiniMonth, 2, '0')
if DoHighlights == 1 then call SetHighlights
if DMC_MiniDirection < 0 then do
DMC_StartColumn = StartDate - MonthLength.DMC_MiniMonth//7
If DMC_StartColumn < 0 then DMC_StartColumn = DMC_StartColumn + 7
DMC_MiniCalLeft = Margin.Left + ShiftLMini
end
else if DMC_MiniDirection > 0 then do
DMC_StartColumn = StartDate + MonthLength.Month//7
If DMC_StartColumn > 6 then DMC_StartColumn = DMC_StartColumn - 7
DMC_MiniCalLeft = FullWidth - Margin.Right - DMC_CalWidth + ShiftRMini
end
else do
DMC_StartColumn = StartDate
DMC_MiniCalLeft = Margin.Left + c * (DMC_CalWidth + MiniCalSpacing)
end
/* Print Month & Year */
DMC_ID.0 = PrintText(1, Margin.Top, DMC_FontType, 'N', Color.MiniCal, Width.DMC_FontType, Month.DMC_MiniMonth' 'Year)
call UpdateBusy(Req, 1)
if App == 'FW' then do
Redraw
GetObjectCoords DMC_ID.0; Parse var RESULT . . DMC_Text.Top DMC_Text.Width .
DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
SetObjectCoords DMC_ID.0 1 DMC_Text.Left DMC_Text.Top DMC_Text.Width Height.DMC_FontType
end
else if App == 'PGS' then do
GETTEXTOBJ POSITION DMC_Text OBJECTID DMC_ID.0 WINDOW winName
DMC_Text.Width = DMC_Text.Right - DMC_Text.Left
DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
EDITTEXTOBJ POSITION DMC_Text.Left DMC_Text.Top (DMC_Text.Left + DMC_Text.Width) DMC_Text.Bottom OBJECTID DMC_ID.0 WINDOW winName
end
/* Print Days */
DMC_Column = DMC_StartColumn
DMC_Day = 0
DMC_Row = 1
Do Until DMC_Day = MonthLength.DMC_MiniMonth
DMC_Day = DMC_Day + 1
DMC_Char1 = left(right(DMC_Day, 2, ' '), 1)
DMC_Char2 = right(DMC_Day, 1)
if (Highlight.DMC_MiniMonth.DMC_Day == '') | (symbol('Highlight.DMC_MiniMonth.DMC_Day') == 'LIT') then do
DMC_Style = 'N'
if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest * 2 - NormalWidth.DMC_Char1 - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
else DMC_CenterAdj = (DMC_ColumnWidth - 2*NormalWidth.Widest)/2 + (NormalWidth.Widest - NormalWidth.DMC_Char2) / 2 + NormalWidth.DMC_Char1 + NormalWidth.DMC_Char2
end
else do
DMC_Style = 'B'
if CenterMiniDates == 1 then DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest * 2 - BoldWidth.DMC_Char1 - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
else DMC_CenterAdj = (DMC_ColumnWidth - 2*BoldWidth.Widest)/2 + (BoldWidth.Widest - BoldWidth.DMC_Char2) / 2 + BoldWidth.DMC_Char1 + BoldWidth.DMC_Char2
end
DMC_Text.Right = (DMC_Column + 1.5) * DMC_ColumnWidth
DMC_Text.Top = Margin.Top + DMC_Row*Height.DMC_FontType
DMC_Text.Left = DMC_MiniCalLeft + DMC_Text.Right - DMC_CenterAdj
DMC_ID.DMC_Day = PrintText(DMC_Text.Left, DMC_Text.Top, DMC_FontType, DMC_Style, Color.MiniCal, Width.DMC_FontType, DMC_Day)
call UpdateBusy(Req, 1)
if pos('#', Highlight.DMC_MiniMonth.DMC_Day) > 0 then do
DMC_BoxCount = DMC_BoxCount + 1
DMC_Box.Left = DMC_MiniCalLeft + (DMC_Column + .5) * DMC_ColumnWidth
DMC_BoxID.DMC_BoxCount = DrawBox(DMC_Box.Left, DMC_Text.Top - (Height.DMC_FontType * ((1 - TextAdj) / 3) * (App == 'FW')), DMC_ColumnWidth, Height.DMC_FontType, 'HL', Line.MiniCal, 0, Black$, 1)
if App == 'FW' then OBJECTTOBACK
else if App == 'PGS' then SENDTOBACK OBJECTID DMC_BoxID.DMC_BoxCount WINDOW winName
end
DMC_Column = DMC_Column + 1
if DMC_Column == 7 then do
DMC_Column = 0
DMC_Row = DMC_Row + 1
end
end
call DrawBox(DMC_MiniCalLeft, Margin.Top, DMC_CalWidth, 7*Height.DMC_FontType, 'HL', Line.MiniCal, 1, Background.MiniCal, 1)
call UpdateBusy(Req, 1)
if App == 'FW' then do
REDRAW
do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT DMC_ID.DMC_i MULTIPLE; End
do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT DMC_BoxID.DMC_i MULTIPLE; End
GROUP
end
if App == 'PGS' then do
do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT ObjectID DMC_ID.DMC_i Add WINDOW winName; End
do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT ObjectID DMC_BoxID.DMC_i Add WINDOW winName; End
GROUP WINDOW winName
end
return
/**/
/***//******* DrawMoon (DM) Subroutine ***********/
DrawMoon:
parse arg DM_Phase, DM_CtrX, DM_CtrY, DM_Color
if App == 'FW' then do
if (DM_Phase == 'N') | (DM_Phase == 'F') then do
if DM_Phase == 'N' then DM_FillColor = DM_Color
else DM_FillColor = White$
OVALPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_FillColor'"'
DRAWOVAL 1 (DM_CtrX - MoonRadius) (DM_CtrY - MoonRadius) (2 * MoonRadius) (2 * MoonRadius)
DM_id = result
end
else do
SHAPEPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_Color'"'
if DM_Phase == 1 then DM_HalfID = DrawHalf('R')
else DM_HalfID = DrawHalf('L')
SHAPEPREFS FILLCOLOR '"'White$'"'
if DM_Phase == 1 then DM_Half2ID = DrawHalf('L')
else DM_Half2ID = DrawHalf('R')
SELECTOBJECT DM_HalfID
SELECTOBJECT DM_Half2ID Multiple
GROUP
CURRENTOBJECT; DM_id = result
end
end
else if App == 'PGS' then do
if (DM_Phase == 'N') | (DM_Phase == 'F') then do
DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius WINDOW winName
DM_id = result
if DM_Phase == 'N' then call SetFill(DM_id, DM_Color, DM_Color)
else call SetFill(DM_id, DM_Color, White$)
end
else do
DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
DM_LHalfID = result
if DM_Phase == 1 then call SetFill(DM_LHalfID, DM_Color, White$)
else call SetFill(DM_LHalfID, DM_Color, DM_Color)
DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
DM_RHalfID = result
if DM_Phase == 1 then call SetFill(DM_RHalfID, DM_Color, DM_Color)
else call SetFill(DM_RHalfID, DM_Color, White$)
SELECTOBJECT OBJECTID DM_LHalfID Add WINDOW winName
GROUP WINDOW winName; DM_id = result
end
end
return DM_id
/**/
/***//******* ExportVariables (EV) Subroutine *********/
ExportVariables:
parse arg EV_File
call open('Temp', FullCallPath)
EV_FileOffset = 120000
call seek('Temp', EV_FileOffset, 'B')
do until (EV_EndPos ~= 0) | (EV_PrevOffset = EV_FileOffset)
EV_PrevOffset = EV_FileOffset
EV_Chunk = readch('Temp', 65535)
EV_EndPos = pos('VarList:'||'0a'x, EV_Chunk)
if EV_EndPos == 0 then EV_FileOffset = seek('Temp', -10, 'C')
end
call seek('Temp', EV_FileOffset + EV_EndPos + 8, 'B')
EV_DefaultVariables = readch('Temp', 65535)
call close('Temp')
call openv('EV_DefaultVariables')
do forever
EV_VarLine = strip(readvln('EV_DefaultVariables'))
EV_VarName = strip(word(EV_VarLine, 1))
EV_VarVal = strip(substr(EV_VarLine, pos('=', EV_VarLine) + 1))
if EV_VarLine == 'return' then leave
EV_Existing = MemberID(EV_VarName, 'RD_Var')
if EV_Existing == -1 then iterate
interpret 'EV_DefaultValue = 'EV_VarVal
EV_CurrentVal = value(value('RD_Var.'EV_Existing))
if EV_CurrentVal ~= EV_DefaultValue then do
if datatype(EV_CurrentVal) == 'CHAR' then EV_CurrentVal = '"'EV_CurrentVal'"'
call writeln(EV_File, right(EV_VarName, VarNameMaxLn)' = 'EV_CurrentVal)
end
end
call closev('EV_DefaultVariables')
return
/**/
/***//******* GetFontWidth (GFW) Subroutine *********/
GetFontWidth:
parse arg GFW_FontType, GFW_FontStyle, GFW_Char
GFW_ID = PrintText(.5, .5, GFW_FontType, GFW_FontStyle, Black$, Width.GFW_FontType, GFW_Char)
if App == 'FW' then do
REDRAW
GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
DELETEOBJECT GFW_ID
end
else if App == 'PGS' then do
GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
GFW_Width = GFW_Text.Right - GFW_Text.Left
DELETEOBJECT OBJECTID GFW_ID WINDOW winName
end
return GFW_Width
/**/
/***//******* GetHeight (GH) Subroutine ***********/
GetHeight:
parse arg GH_FontType
if App == 'FW' then do
TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
end
else if App == 'PGS' then do
DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
SELECTTEXT AT 0 0 WINDOW winName
BEGINCOMMANDCAPTURE
SETLEADING RELATIVE 100
SETTYPESIZE FSize.GH_FontType WINDOW winName
SETFONT Font.GH_FontType WINDOW winName
ENDCOMMANDCAPTURE
INSERT 'A' WINDOW winName
GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
GH_Text.Height = GH_Text.Bottom - GH_Text.Top
DELETEOBJECT OBJECTID GH_id WINDOW winName
end
return GH_Text.Height
/**/
/***//******* GetLogInfo () Subroutine ***********/
GetLogInfo:
if ~exists(Storage'FWC'App'Temp.txt') then address command 'list >'Storage'FWC'App'Temp.txt 'AppName'#? lformat %N'
if open('Temp', Storage'FWC'App'Temp.txt') ~= 0 then do
do while ~eof('Temp')
PgmName = readln('Temp')
if pos('.', PgmName) == 0 then leave
end
call close('Temp')
end
if ~exists(Storage'FWC'App'VersionInfo.txt') then address command 'version >'Storage'FWC'App'VersionInfo.txt 'PgmName
call open('Temp', Storage'FWC'App'VersionInfo.txt')
address command 'copy 'Storage'FWC'App'VersionInfo.txt ram:versioninfo.txt'
PgmVersion = readln('Temp')
call close('Temp')
if left(PgmVersion, 34) == 'Could not find version information' then do
if App == 'FW' then do
call open('Temp', CurrentDir''PgmName)
/* Desired string at 325365 for v 5.06 */
/* Desired string at 333771 for FW97 */
FileOffset = 325300
call seek('Temp', FileOffset, 'B')
do until (EndPos ~= 0) | (PrevOffset = FileOffset)
PrevOffset = FileOffset
Chunk = readch('Temp', 10000)
EndPos = pos('Created', Chunk)
if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
end
if EndPos == 0 then PgmVersion = 'Final Writer - version unknown'
else do
StartPos = lastpos('Final', Chunk, EndPos)
EndPos = pos('00'x||'00'x, Chunk, StartPos)
PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
end
call close('Temp')
call open('Temp', Storage'FWC'App'VersionInfo.txt', 'W')
call writeln('Temp', PgmVersion)
call close('Temp')
end
else PgmVersion = PgmName" - can't find version info"
end
return
/**/
/***//******* GetMaxWidth (GMW) Subroutine ***********/
GetMaxWidth:
parse arg GMW_Stem, GMW_Count
GMW_maxwidth = 0
Do GMW_i = 0 to GMW_Count
interpret 'GMW_ObjectID = 'GMW_Stem'.'GMW_i
if App = 'FW' then do
GETOBJECTCOORDS GMW_ObjectID
Parse Var result . . . GMW_width .
end
else if App == 'PGS' then do
SELECTOBJECT ObjectID GMW_ObjectID WINDOW winName
GETTEXTOBJ POSITION GMW_Temp OBJECTID GMW_ObjectID WINDOW winName
GMW_width = GMW_Temp.Right - GMW_Temp.Left
end
GMW_maxwidth = max(GMW_width, GMW_maxwidth)
end
return GMW_maxwidth
/**/
/***//******* GetMiniMax (GMM) Subroutine ***********/
GetMiniMax:
parse arg GMM_FontType
NormalWidth.Widest = 0
BoldWidth.Widest = 0
do GMM_i = 0 to 9
NormalWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'N', Black$, Width.GMM_FontType, GMM_i)
BoldWidthID.GMM_i = PrintText(1, 1, GMM_FontType, 'B', Black$, Width.GMM_FontType, GMM_i)
end
if App == 'FW' then REDRAW
do GMM_i = 0 to 9
NormalWidth.GMM_i = GetWidth(NormalWidthID.GMM_i)
BoldWidth.GMM_i = GetWidth(BoldWidthID.GMM_i)
NormalWidth.Widest = max(NormalWidth.Widest, NormalWidth.GMM_i)
BoldWidth.Widest = max(BoldWidth.Widest, BoldWidth.GMM_i)
if App == 'PGS' then do
DELETEOBJECT OBJECTID NormalWidthID.GMM_i WINDOW winName
DELETEOBJECT OBJECTID BoldWidthID.GMM_i WINDOW winName
end
end
return
/**/
/***//******* GetPhases (GP) Subroutine ***********/
GetPhases:
parse arg GP_Y, GP_Month
if DateLib == 1 then do
GP_Phase.0 = 'N'
GP_Phase.1 = '1'
GP_Phase.2 = 'F'
GP_Phase.3 = '3'
GP_JD = date_GregorianToJD(1, GP_Month, GP_Y)
do GP_SeqDate = GP_JD - 22 to GP_JD + 39
call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')
do GP_Phase = 0 to 3
GP_SeqDate = date_GregorianMoonPhase(GP_Day, GP_Month, GP_Year, GP_Phase)
call date_JDToGregorian(GP_SeqDate, 'GP_DAY GP_MONTH GP_YEAR')
MoonPhase.GP_Year.GP_Month.GP_Day = GP_Phase.GP_Phase
end
end
end
else do
/* Routine to determine the dates of the new and full moons for a given year */
/* obtained from the Sky & Telescope web site. The basic program from which */
/* the following was derived originally appeared in Astronomical Computing, */
/* Sky & Telescope, March, 1985 */
GP_Progress = -2
GP_R1 = PI(0) / 180
GP_NextPhase = 29.530588853 / 4
GP_U = 0
GP_K0 = trunc((GP_Y - 1900) * 12.3685)
GP_T = (GP_Y - 1899.5) / 100
GP_T2 = GP_T*GP_T
GP_T3 = GP_T*GP_T*GP_T
GP_J0 = 2415020 + 29 * GP_K0
GP_F0 = 0.0001178 * GP_T2 - 0.000000155 * GP_T3 + 0.75933 + 0.53058868 * GP_K0 - 0.000837 * GP_T - 0.000335 * GP_T2
GP_J0 = GP_J0 + trunc(GP_F0)
GP_F0 = GP_F0 - trunc(GP_F0)
GP_M0 = GP_K0 * 0.08084821133
GP_M0 = 360 * (GP_M0 - trunc(GP_M0)) + 359.2242 - 0.0000333 * GP_T2 - 0.00000347 * GP_T3
GP_M1 = GP_K0 * 0.07171366128
GP_M1 = 360 * (GP_M1 - trunc(GP_M1)) + 306.0253 + 0.0107306 * GP_T2 + 0.00001236 * GP_T3
GP_B1 = GP_K0 * 0.08519585128
GP_B1 = 360 * (GP_B1 - trunc(GP_B1)) + 21.2964 - 0.0016528 * GP_T2 - 0.00000239 * GP_T3
do GP_K9 = 0 to 28
if GP_K9//4 == 0 then do
GP_Progress = -GP_Progress
call UpdateBusy(Req, GP_Progress)
end
GP_J = GP_J0 + 14 * GP_K9
GP_F = GP_F0 + 0.765294 * GP_K9
GP_K = GP_K9 / 2
GP_M5 = (GP_M0 + GP_K * 29.10535608) * GP_R1
GP_M6 = (GP_M1 + GP_K * 385.81691806) * GP_R1
GP_B6 = (GP_B1 + GP_K * 390.67050646) * GP_R1
GP_F = GP_F - 0.4068 * SIN(GP_M6) + (0.1734 - 0.000393 * GP_T) * SIN(GP_M5) + 0.0161 * SIN(2 * GP_M6)
GP_F = GP_F + 0.0104 * SIN(2 * GP_B6) - 0.0074 * SIN(GP_M5 - GP_M6) - 0.0051 * SIN(GP_M5 + GP_M6)
GP_F = GP_F + 0.0021 * SIN(2 * GP_M5) + 0.0010 * SIN(2 * GP_B6 - GP_M6)
GP_J = GP_J + trunc(GP_F)
GP_F = GP_F - trunc(GP_F)
GP_Converted = ConvertJ(GP_F, GP_J)
GP_Y = word(GP_Converted, 1) - 0
GP_M = word(GP_Converted, 2) - 0
GP_Day = word(GP_Converted, 3) - 0
GP_Hrs = word(GP_Converted, 4)
if GP_U = 0 then do
MoonPhase.GP_Y.GP_M.GP_Day = 'N'
GP_FQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
GP_Y = left(GP_FQ, 4)
GP_M = strip(substr(GP_FQ, 5, 2), 'L', '0')
GP_Day = strip(right(GP_FQ, 2), 'L', '0')
MoonPhase.GP_Y.GP_M.GP_Day = '1'
end
if GP_U = 1 then do
MoonPhase.GP_Y.GP_M.GP_Day = 'F'
GP_TQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
GP_Y = left(GP_TQ, 4)
GP_M = strip(substr(GP_TQ, 5, 2), 'L', '0')
GP_Day = strip(right(GP_TQ, 2), 'L', '0')
MoonPhase.GP_Y.GP_M.GP_Day = '3'
end
GP_U = GP_U + 1
if GP_U = 2 then GP_U = 0
end
if sign(GP_Progress) == 1 then call UpdateBusy(Req, -GP_Progress)
end
return 0
/**/
/***//******* GetSetupInfo (GSI) Subroutine ***********/
GetSetupInfo:
Year = left(date('S'),4)
ThisMonth = left(date('U'), 2) + 0
if (owner == 'rgoertz') & (CallHost == 'REXX') then CalMonth = ThisMonth
else do
CalMonth = getclip('FWC_CalMonth')
if datatype(CalMonth) == 'CHAR' then do
CalMonth = ThisMonth
AddYear = 0
end
else do
CalMonth = CalMonth + 1
if CalMonth = 13 then do
CalMonth = 1
AddYear = 1
end
else AddYear = 0
end
CalYear = getclip('FWC_CalYear')
if (CalYear ~= '') & (DataType(CalYear) == 'NUM') then Year = CalYear + AddYear
end
call InitializeVariables
PrefsFile = 'Default'
if (exists(ScriptDir''ChangesFile)) & (word(statef(ScriptDir''ChangesFile), 2) > 2) then do
if open('DataFile', ScriptDir''ChangesFile) then do
GSI_Data = readch('DataFile', 65535)
call close('DataFile')
call OpenV('GSI_Data')
GSI_StringVar = 0
do until eofv('GSI_Data')
GSI_Ln = readvln('GSI_Data')
GSI_Var = upper(word(GSI_Ln, 1))
if (right(GSI_Var, 1) == '$') |,
(GSI_Var == 'DOSHANGHAI') |,
(GSI_Var == 'STORAGE') |,
(GSI_Var == 'PREFSFILE') then interpret GSI_Ln
end
call CloseV('GSI_Data')
end
end
call makedir(left(Storage, length(Storage) - 1))
call ReadTranslations
call InitializeSettings
do until Reset == 0
call CheckShanghai
call ReadTranslations
Req = OpenBusy(PrepReq$'...', 6)
call CreateDataFile
call ReadData
call CheckShanghai
call DoSetupReq
call CheckShanghai
if Reset == 1 then call bguiwinclose(winID)
end
if ImageClass.0 ~= '' then
do GSI_i = 0 to ImageClass.Count - 1
parse var ImageFile.GSI_i ImageFile.GSI_i ',' GSI_DX ',' GSI_DY
GSI_DX = strip(GSI_DX);if GSI_DX == '' then GSI_DX = 0
GSI_DY = strip(GSI_DY);if GSI_DY == '' then GSI_DY = 0
if (pos('/', ImageFile.GSI_i) == 0) & (pos(':', ImageFile.GSI_i) == 0) then
ImageFile.GSI_i = ScriptDir'Images/'ImageFile.GSI_i
ImageDX.GSI_i = GSI_DX
ImageDY.GSI_i = GSI_DY
end
do GSI_i = 1 to 8
if (Do.GSI_i='BothJ') | (Do.GSI_i='BothS') then iterate
interpret 'Do'Do.GSI_i' = 0'
end
do GSI_i = 0 to GroupCount
pos = pos.GSI_i
option = option.pos
if Do.option == 'BothJ' then do
DoJulian = pos.GSI_i
DoJulianLeft = pos.GSI_i
end
else if Do.option == 'BothS' then do
DoSunrise = pos.GSI_i
DoSunset = pos.GSI_i
end
else interpret 'Do'Do.option" = '"pos.GSI_i"'"
end
TopOption = 0
do GSI_i = 1 to 8
if (Do.GSI_i='BothJ') | (Do.GSI_i='BothS') then iterate
if left(value('Do'Do.GSI_i), 1) == 'T' then do
TopOption = 1
leave
end
end
call WriteData
if CalType == 1 then Calendar = Month.Month' 'EnteredYear
else Calendar = EnteredYear
call bguiwinclose(winID)
Mn = right(Month, 2, '0')
if DataType(Month) == 'NUM' then call setclip('FWC_CalMonth', Month)
if DataType(EnteredYear) == 'NUM' then call setclip('FWC_CalYear', EnteredYear)
return
/**/
/***//******* GetSRSS (GS) Subroutine ***********/
GetSRSS:
parse arg GS_IDay
GS_EDay = translate(DateInfo('E', GS_IDay, 'I'), '-', '/')
if AdjustDST ~= 0 then do
if GS_IDay < StartDST | GS_IDay >= EndDST then call WriteEnv('suncalc/dst', 0)
else call WriteEnv('suncalc/dst', 1)
end
address command Storage'suncalc > 'Storage'SRSS.txt date='GS_EDay' text="$SR $SS"'
call open('SRSS', Storage'SRSS.txt')
GS_SRSS = readln('SRSS')
call close('SRSS')
return GS_SRSS
/**/
/***//******* GetWidth (GW) Subroutine ***********/
GetWidth:
parse arg GW_ID
if App = 'FW' then do
GETOBJECTCOORDS GW_ID
Parse Var result . . . GW_width .
end
else if App == 'PGS' then do
SELECTOBJECT OBJECTID GW_ID WINDOW winName
GETTEXTOBJ POSITION GW_Temp OBJECTID GW_ID WINDOW winName
GW_width = GW_Temp.Right - GW_Temp.Left
end
return GW_width
/**/
/***//******* HalveBox (HB) Subroutine ***********/
HalveBox:
parse arg HB_ID
if App = 'FW' then do
GETOBJECTCOORDS HB_ID
parse var result . HB_Left HB_Top HB_Width HB_Height
SETOBJECTCOORDS HB_ID 1 HB_Left HB_Top HB_Width HB_Height/2
end
else if App == 'PGS' then do
GETBOX POSITION HB_Coords OBJECTID HB_ID WINDOW winName
HB_Bottom = HB_Coords.Top + (HB_Coords.Bottom - HB_Coords.Top) / 2
EDITBOX POSITION HB_Coords.Left HB_Coords.Top HB_Coords.Right HB_Bottom OBJECTID HB_ID WINDOW winName
end
return HB_ID
/**/
/***//******* LibVer (LV) Subroutine *********/
LibVer: /* Retrieve the version number of a library */
parse arg LV_libname
if right(LV_libname,8) ~= '.library' then LV_libname = LV_libname'.library'
address command 'version' 'libs:'LV_Libname '>env:LibVer'
LV_libver = ReadEnv('LibVer')
return LV_libver
/**/
/***//******* MemberID (MI) Subroutine *********/
MemberID:
parse arg MI_Member, MI_Array, MI_Count, MI_Start
if MI_Count == '' then interpret 'MI_Count = 'MI_Array'.Count'
if MI_Start == '' then MI_Start = 0
if MI_Start == 0 then MI_Count = MI_Count - 1
do MI_i = MI_Start to MI_Count
if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
end
return -1
/**/
/***//******* MiniCalPreCalc (MCPC) Subroutine *********/
MiniCalPreCalc:
parse arg MCPC_FontType, MCPC_CalWidth
Width.MCPC_FontType = 100 * min(1, MCPC_CalWidth / (22 * BoldWidth.Widest))
if App == 'FW' then Width.MCPC_FontType = trunc(Width.MCPC_FontType)
do MCPC_i = 0 to 9
NormalWidth.MCPC_i = NormalWidth.MCPC_i * Width.MCPC_FontType / 100
BoldWidth.MCPC_i = BoldWidth.MCPC_i * Width.MCPC_FontType / 100
end
NormalWidth.Widest = NormalWidth.Widest * Width.MCPC_FontType / 100
BoldWidth.Widest = BoldWidth.Widest * Width.MCPC_FontType / 100
return
/**/
/***//******* Move (M) Subroutine ***********/
Move:
parse arg M_ID, M_dX, M_dY
if M_ID == 0 then return
if App = 'FW' then do
GETOBJECTCOORDS M_ID; Parse Var result . M_Coords.Left M_Coords.Top M_Coords.Width M_Coords.Height
SETOBJECTCOORDS M_ID 1 (M_Coords.Left + M_dX) (M_Coords.Top + M_dY) M_Coords.Width M_Coords.Height
end
else if App == 'PGS' then MOVE OFFSET M_dX M_dY OBJECTID M_ID WINDOW winName
return
/**/
/***//******* NameOnly (NO) Subroutine ***********/
NameOnly:
parse arg NO_fontname
return substr(NO_fontname, max(lastpos(':', NO_fontname), lastpos('/', NO_fontname)) + 1)
/**/
/***//******* OpenBusy (OB) Subroutine ***********/
OpenBusy:
parse arg OB_BusyTitle, OB_EventCount
Progress = 0
OB_ProgressGroup=bguivgroup(,
bguiinfo('OB_dummy',,'1B'x||'c'OB_BusyTitle)bguilayout(LGO_FixMinHeight,1)||,
bguiprogress('OB_prog2_',,0,OB_EventCount)||,
bguihgroup(,
bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
bguibutton('OB_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
,,,,'W'),
,-2,-2)
OB_ProgressWindow = bguiwindow(PleaseWait$'...',OB_ProgressGroup,,2,,PubScreen)
if bguiwinopen(OB_ProgressWindow) = 0 then call Cleanup
return OB_ProgressWindow
/**/
/***//******* ParseVariables (PV) Subroutine ***********/
ParseVariables:
parse arg PV_Line
PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
PV_VarString = ''
PV_Var. = '00'x
PV_LongVar = 4
PV_LIT = ''
PV_Count = 0
do PV_i = 1 to words(PV_String)
PV_Word = word(PV_String, PV_i)
if pos(PV_Word'(', PV_Line) > 0 then iterate
if datatype(PV_Word) == 'CHAR' then do
if (symbol(PV_Word) == 'LIT') then PV_LIT = PV_LIT''PV_Word', '
if (symbol(PV_Word) == 'VAR') | (pos('.', PV_Word) > 0) then do
if symbol(PV_Word) == 'VAR' then do
PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
if PV_Var.PV_Word == '00'x then do
PV_Count = PV_Count + 1
PV_Var.PV_Count = PV_Word
PV_Var.PV_Word = value(PV_Word)
end
end
if pos('.', PV_Word) > 0 then do
PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
do PV_j = 1 to words(PV_CompoundParts)
PV_Subword = word(PV_CompoundParts, PV_j)
PV_LongVar = max(PV_LongVar, length(PV_SubWord) + 2)
if PV_Var.PV_SubWord == '00'x then do
PV_Count = PV_Count + 1
PV_Var.PV_Count = PV_SubWord
if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord = 'LIT'
else PV_Var.PV_SubWord = value(PV_SubWord)
end
end
end
end
end
end
do PV_i = 1 to PV_Count
PV_Word = PV_Var.PV_i
if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
end
if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
return PV_VarString
/**/
/***//******* PathPart (PP) Subroutine ***********/
PathPart:
parse arg PP_FileWithPath
return left(PP_FileWithPath, max(lastpos(':', PP_FileWithPath), lastpos('/', PP_FileWithPath)))
/**/
/***//******* PrintHighlight (PH) Subroutine ***********/
PrintHighlight:
parse arg PH_Event
/* Fit line(s) into allowable space */
PH_Textline = 0
PH_Text. = ''
PH_Text.PH_Textline = PH_Event
Do until PH_Text.PH_Nextline == ''
PH_AllowedWidth = BoxWidth - 2 * DateOffset - HighlightOffset
PH_Nextline = PH_Textline + 1
if PH_Textline == 0 then PH_Indent.PH_Textline = 0
else PH_Indent.PH_Textline = Width.WidthOfDate1
PH_AllowedWidth = PH_AllowedWidth - PH_Indent.PH_Textline
if PH_Event == '' then do
PH_Text.PH_TextLine = ''
iterate
end
if App == 'FW' & length(PH_Text.PH_Textline) > 37 then do
PH_Wordbreak = lastpos(' ', PH_Text.PH_Textline, 37)
PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
end
PH_ID = PrintText(1, 1, Highlight, 'N', Color.Highlight, Width.Highlight, PH_Text.PH_Textline)
if App == 'FW' then redraw
PH_TextWidth.PH_Textline = GetWidth(PH_ID)
if App == 'FW' then DELETEOBJECT PH_ID
else if App == 'PGS' then do
SELECTOBJECT ObjectID PH_ID WINDOW winName
DELETEOBJECT ObjectID PH_ID WINDOW winName
end
PH_NeededCompression.PH_Textline = min(1, PH_AllowedWidth/PH_TextWidth.PH_Textline)
if (PH_NeededCompression.PH_Textline < MinWidth/100) & (Words(PH_Text.PH_Textline) > 1) then do
/* Move last word to next line */
PH_Wordbreak = lastpos(' ', PH_Text.PH_Textline)
PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
end
else if PH_Text.PH_Nextline ~= '' then PH_Textline = PH_Textline + 1
end
PH_LineCount = PH_Textline
do PH_TextLine = 0 to PH_LineCount
if PH_Text.PH_TextLine ~= '' then do
TextLeft = BoxLeft + DateOffset + HighlightOffset * (DailyHLCount * Height.Highlight < Height.Date * TextBase)
PH_TextTop = BoxTop + DailyHLCount * Height.Highlight
PH_Width = PH_NeededCompression.PH_Textline * Width.Highlight
if App == 'FW' then PH_Width = min(max(trunc(PH_Width), 4), 255)
call PrintText(TextLeft + PH_Indent.PH_TextLine, PH_TextTop, Highlight, 'N', TextColor, PH_Width, PH_Text.PH_TextLine)
end
if PH_TextLine ~= PH_LineCount then DailyHLCount = DailyHLCount + 1
end
return
/**/
/***//******* PrintOption (PO) Subroutine ***********/
PrintOption:
parse arg PO_Location
PO_ID = PrintText(BoxLeft + DateOffset, BoxTop + (BHeight - Height.Extras) * (left(PO_Location, 1) ~= 'T'), Extras, 'N', DO_PrintColor, Width.Extras, DO_Text2Print)
if right(PO_Location, 1) == 'C' then call CenterText(PO_ID, BoxLeft + BoxWidth / 2, 0, min(1, BoxWidth/GetWidth(PO_ID)))
if right(PO_Location, 1) == 'R' then call RightText(PO_ID, BoxLeft + BoxWidth - 2 * DateOffset)
return PO_ID
/**/
/***//******* PrintText (PT) Subroutine ***********/
PrintText:
parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
else PT_Font = Bold.PT_FontType
if App == 'FW' then do
if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
PT_Top = PT_Top + TextAdj * Height.PT_FontType
TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
DRAWTEXTBLOCK 1 trunc(PT_Left, 4) trunc(PT_Top, 4) PT_Text; PT_id = result
end
else if App == 'PGS' then do
DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
SELECTTEXT AT PT_Left PT_Top WINDOW winName
BEGINCOMMANDCAPTURE
SETLEADING RELATIVE 100
SETTYPESIZE FSize.PT_FontType WINDOW winName
SETTYPEWIDTH PT_Width WINDOW winName
SETFONT PT_Font WINDOW winName
SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
ENDCOMMANDCAPTURE
if pos('"', PT_Text) > 0 then do
call open('IFile', Storage'Text2Insert.txt', 'W')
call WriteLn('IFile', PT_Text)
call close('IFile')
INSERTTEXT FILE Storage'Text2Insert.txt' FILTER ASCII WINDOW winName
end
else INSERT '"'PT_Text'"' WINDOW winName
end
return PT_id
/**/
/***//******* ReadData (RD) Subroutine ***********/
ReadData:
call UpdateBusy(Req, 1)
RD_VarCount = 0
RD_ColorCount = 0
RD_FontCount = 0
RD_ICCount = 0
RD_SL = 0
RD_Var. = ''
RD_UpdateVars = 0
RD_Progress = -1
PrefsFile = ''
PrefsName = ''
VarNameMaxLn = 0
if open('DataFile', ScriptDir''ChangesFile) then do
DataFile = readch('DataFile', 65535)
call close('DataFile')
call openv('DataFile')
RD_DataVersion = readvln('DataFile')
if pos('Dataversion', RD_DataVersion) == 0 then do
call seekv('DataFile', 0, 'B')
RD_UpdateVars = 1
end
else if word(RD_DataVersion, 2) ~= word(sourceline(4), 3) then RD_UpdateVars = 1
do until eofv('DataFile')
RD_Ln = ReadVLn('DataFile')
if RD_Ln = '' then iterate
RD_VarName = strip(word(RD_Ln, 1))
VarNameMaxLn = max(VarNameMaxLn, length(RD_VarName))
if right(RD_VarName, 1) == '$' then iterate
if RD_VarName == 'PrefsFile' then do
interpret RD_Ln
if PrefsFile ~= 'Default' then do
if open('UserFile', PrefsFile) then do
do until eof('UserFile')
RD_VarLine = strip(ReadLn('UserFile'))
RD_VarName = upper(strip(word(RD_VarLine, 1)))
if left(RD_VarLine, 15) == '/* End Pass One' then leave
if (right(RD_VarName, 1) == '$') then interpret RD_VarLine
end
call close('UserFile')
end
end
iterate
end
RD_VarDone = 0
RD_VarStem = upper(left(RD_VarName, pos('.', RD_VarName)))
RD_Var.RD_SL = RD_VarName
RD_SL = RD_SL + 1
if RD_VarStem ~= 'IMAGECLASS.' then interpret RD_Ln
if (upper(left(RD_VarName, 7)) == 'STORAGE') |,
(upper(left(RD_VarName, 7)) == 'MARGIN.') |,
(upper(RD_VarName) == 'PREFSFILE') then iterate
if (upper(left(RD_VarName, 2)) == 'DO') & (upper(RD_VarName) ~= 'DOHIDE') & (upper(RD_VarName) ~= 'DOSHANGHAI') then RD_VarDone = 1
if RD_VarStem == 'IMAGECLASS.' then do
ImageClass.RD_ICCount = upper(substr(RD_VarName, 12))
interpret 'ImageFile.'RD_ICCount' = 'strip(substr(RD_Ln, pos('=', RD_Ln) + 1))
RD_ICCount = RD_ICCount + 1
VarName.RD_VarCount = RD_VarName
RD_VarCount = RD_VarCount + 1
RD_VarDone = 1
end
if (RD_VarStem == 'ALTCOLOR.') |,
(RD_VarStem == 'BACKGROUND.') |,
(RD_VarStem == 'COLOR.') |,
(RD_VarStem == 'LINE.') then do
if (MemberID(value(RD_VarName), 'ColorList') == -1) then do
if (value(RD_VarName) == '<'Clear$'>') & (RD_VarStem == 'BACKGROUND.') then nop
else do
call AddMsg('W', value(RD_VarName)" can't be found; "ColorList.0" used instead.")
interpret RD_VarName' = "'ColorList.0'"'
end
end
ColorName.RD_ColorCount = RD_VarName
RD_ColorCount = RD_ColorCount + 1
RD_VarDone = 1
end
if (RD_VarStem == 'FONT.') | (RD_VarStem == 'BOLD.') then do
FontName.RD_FontCount = RD_VarName
RD_FontCount = RD_FontCount + 1
RD_VarDone = 1
end
if RD_VarDone == 0 then do
VarName.RD_VarCount = RD_VarName
RD_VarCount = RD_VarCount + 1
end
end
call closev('DataFile')
end
else do
call AddMsg('E', 'Unable to open 'ScriptDir''ChangesFile)
call Cleanup
end
if RD_UpdateVars == 1 then do /* See if new default variables were added */
call open('Temp', FullCallPath)
FileOffset = 120000
call seek('Temp', FileOffset, 'B')
do until (EndPos ~= 0) | (PrevOffset = FileOffset)
PrevOffset = FileOffset
Chunk = readch('Temp', 65535)
EndPos = pos('VarList:'||'0a'x, Chunk)
if EndPos == 0 then FileOffset = seek('Temp', -10, 'C')
end
call seek('Temp', FileOffset + EndPos + 8, 'B')
DefaultVariables = readch('Temp', 65535)
call close('Temp')
call openv('DefaultVariables')
do forever
RD_VarDone = 0
RD_VarLine = strip(readvln('DefaultVariables'))
RD_VarName = strip(word(RD_VarLine, 1))
RD_VarStem = upper(left(RD_VarName, pos('.', RD_VarName)))
if RD_VarLine == 'return' then leave
if (upper(left(RD_VarName, 7)) == 'STORAGE') |,
(upper(left(RD_VarName, 7)) == 'MARGIN.') then iterate
if upper(left(RD_VarName, 2)) == 'DO' then do
if (upper(RD_VarName ~= 'DOHIDE')) & (upper(RD_VarName ~= 'DOSHANGHAI')) then do
if MemberID(RD_VarName, 'RD_Var', RD_SL) == -1 then do
interpret RD_VarLine
RD_Var.RD_SL = RD_VarName
RD_SL = RD_SL + 1
end
end
RD_VarDone = 1
end
if (RD_VarStem == 'ALTCOLOR.') |,
(RD_VarStem == 'BACKGROUND.') |,
(RD_VarStem == 'COLOR.') |,
(RD_VarStem == 'LINE.') then do
if MemberID(RD_VarName, 'ColorName', RD_ColorCount) == -1 then do
interpret RD_VarLine
RD_Var.RD_SL = RD_VarName
RD_SL = RD_SL + 1
ColorName.RD_ColorCount = RD_VarName
RD_ColorCount = RD_ColorCount + 1
end
RD_VarDone = 1
end
if (RD_VarStem == 'FONT.') | (RD_VarStem == 'BOLD.') then do
if MemberID(RD_VarName, 'FontName', RD_FontCount) == -1 then do
interpret RD_VarLine
RD_Var.RD_SL = RD_VarName
RD_SL = RD_SL + 1
FontName.RD_FontCount = RD_VarName
RD_FontCount = RD_FontCount + 1
end
RD_VarDone = 1
end
if RD_VarDone == 0 then do
if MemberID(RD_VarName, 'VarName', RD_VarCount) == -1 then do
interpret RD_VarLine
RD_Var.RD_SL = RD_VarName
RD_SL = RD_SL + 1
VarName.RD_VarCount = RD_VarName
RD_VarCount = RD_VarCount + 1
end
end
end
call closev('DefaultVariables')
end
if PrefsFile == '' then do
if exists(ScriptDir''FWCData) then PrefsFile = ScriptDir''FWCData
else PrefsFile = 'Default'
end
if PrefsName == '' then PrefsName = PrefsFile
RD_Var.COUNT = RD_SL
VarName.COUNT = RD_VarCount
ColorName.COUNT = RD_ColorCount
FontName.COUNT = RD_FontCount
ImageClass.COUNT = RD_ICCount
ColorName = ColorName.0
FontName = FontName.0
VarName = VarName.0
if upper(left(VarName, pos('.', VarName))) == 'IMAGECLASS.' then do
IC = MemberID(upper(substr(VarName, 12)), 'ImageClass')
VarVal = ImageFile.IC
end
else VarVal = Value(VarName)
if upper(Orientation) == 'WIDE' then OrientChoice = 0
else OrientChoice = 1
call UpdateBusy(Req, 1)
if (exists(SunCalcPath'suncalc')) & (~exists(Storage'suncalc')) then address command 'copy 'SunCalcPath'suncalc 'Storage
call UpdateBusy(Req, 1)
if (exists(GfxAppPath''GfxApp)) & (~exists(Storage''GfxApp)) then address command 'copy 'GfxAppPath''GfxApp' 'Storage
if ~exists(Storage''GfxApp) then DoImages = 0
if PhaseLib ~= 1 then DoPhases = 0
return
/**/
/***//******* ReadEnv (RE) Subroutine ***********/
ReadEnv: PROCEDURE
parse arg file
if open('Temp', 'ENV:'file) then do
val = strip(readch('Temp', 65535), 'B', ' '||'0a'x)
call close('Temp')
end
else val = ''
return val
/**/
/***//******* ReplaceString (RS) Subroutine ***********/
ReplaceString: PROCEDURE
parse arg old, new, string
if pos(old, string) > 0 then do
parse var string begin(old)end
return begin || new || ReplaceString(old, new, end)
end
return string
/**/
/***//******* RightText (RT) Subroutine ***********/
RightText:
parse arg RT_id, RT_RightEdge
if App = 'FW' then do
GETOBJECTCOORDS RT_id; Parse Var result . . RT_Text.Bottom RT_Text.Width RT_Text.Height
RT_Text.Left = RT_RightEdge - RT_Text.Width
SETOBJECTCOORDS RT_id 1 RT_Text.Left RT_Text.Bottom RT_Text.Width RT_Text.Height
end
else if App == 'PGS' then do
GETTEXTOBJ POSITION RT_Text OBJECTID RT_id WINDOW winName
RT_Text.Width = RT_Text.Right - RT_Text.Left
RT_Text.Left = RT_RightEdge - RT_Text.Width
EDITTEXTOBJ POSITION RT_Text.Left RT_Text.Top (RT_Text.Left + RT_Text.Width) RT_Text.Bottom OBJECTID RT_id WINDOW winName
end
return RT_id
/**/
/***//******* ReadTranslations (RTr) Subroutine ***********/
ReadTranslations:
if exists(PrefsFile) then do
if open('DataFile', PrefsFile) then do
do until eof('DataFile')
RTr_Ln = ReadLn('DataFile')
RTr_Var = upper(word(RTr_Ln, 1))
if right(RTr_Var, 1) == '$' then interpret RTr_Ln
else if pos('/* End Pass One', RTr_Ln) > 0 then leave
end
call close('DataFile')
end
end
Month.1 = January$
Month.2 = February$
Month.3 = March$
Month.4 = April$
Month.5 = May$
Month.6 = June$
Month.7 = July$
Month.8 = August$
Month.9 = September$
Month.10 = October$
Month.11 = November$
Month.12 = December$
return
/**/
/***//******* SaveVariable (SV) Subroutine ***********/
SaveVariable:
parse arg SV_OutFile, SV_Variable, SV_Value
SV_Cmd = SV_Variable' = 'SV_Value
call WriteLn(SV_OutFile, SV_Cmd)
interpret SV_Cmd
return
/**/
/***//******* SetFill (SF) Subroutine ***********/
SetFill:
parse arg SF_ID, SF_StrokeColor, SF_FillColor
BEGINCOMMANDCAPTURE
SETSTROKEWEIGHT '0.3pt' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
SETCOLORSTYLE '"'SF_StrokeColor'"' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
FILLED 'ON'
SETCOLORSTYLE '"'SF_FillColor'"' FILL OBJECT OBJECTID SF_ID WINDOW winName
ENDCOMMANDCAPTURE
return
/**/
/***//******* SetHighlights (SH) Subroutine ***********/
SetHighlights:
/* The algorithm for calculating Easter is due to J.-M. Oudin (1940) and is */
/* reprinted in the Explanatory Supplement to the Astronomical Almanac, ed. P. K. */
/* Seidelmann (1992). See Chapter 12, "Calendars", by L. E. Doggett. */
/* */
/* I obtained the algorithm from the US Naval Observatory web site */
SettingHighlights = 1
SH_Progress = -2
if EasterKnown ~= 1 then do
SH_century = trunc(Year / 100)
SH_n = trunc(Year - 19 * trunc(Year / 19))
SH_k = trunc((SH_century - 17) / 25)
SH_i = SH_century - trunc(SH_century / 4) - trunc((SH_century - SH_k) / 3) + 19 * SH_n + 15
SH_i = SH_i - 30 * trunc(SH_i / 30)
SH_i = SH_i - trunc(SH_i / 28) * (1 - trunc(SH_i / 28) * trunc(29 / (SH_i + 1)) * trunc((21 - SH_n) / 11))
SH_j = Year + trunc(Year / 4) + SH_i + 2 - SH_century + trunc(SH_century / 4)
SH_j = SH_j - 7 * trunc(SH_j / 7)
SH_l = SH_i - SH_j
SH_EasterMonth = 3 + trunc((SH_l + 40 ) / 44)
SH_EasterDay = SH_l + 28 - 31 * trunc(SH_EasterMonth / 4)
EasterSerial = DateInfo('I', Year'0'SH_EasterMonth''right(SH_EasterDay, 2, '0'), 'S')
EasterKnown = 1
end
Highlight. = ''
Image. = ''
if PrefsFile ~= 'Default' then do
call open('DataFile', PrefsFile)
do forever
if eof('DataFile') then leave
if pos('/* End Pass One', readln('DataFile')) > 0 then do
do until eof('DataFile')
SH_Ln = ReadLn('DataFile')
SH_Ln2 = left(SH_Ln, 2)
if upper(left(SH_Ln, 14)) == 'CALCULATEEDATE' then interpret 'call 'SH_Ln
if (SH_Ln2 == Mn) | (SH_Ln2 == '13') then do
SH_Progress = -SH_Progress
call UpdateBusy(Req, SH_Progress)
select
when upper(substr(SH_Ln, 3, 13)) == 'CALCULATEDATE' then interpret 'call 'substr(SH_Ln, 3)
when upper(substr(SH_Ln, 3, 9)) == 'HIGHLIGHT' then call AssignHighlight(substr(SH_Ln, 3))
when upper(substr(SH_Ln, 3, 5)) == 'IMAGE' then call AssignImage(substr(SH_Ln, 3))
when upper(substr(SH_Ln, 3, 14)) == 'CALCULATEIMAGE' then interpret 'call 'substr(SH_Ln, 3)
otherwise do
call AddMsg('W', 'Check the keyword in the following line of your FWCalendar.data file:')
call AddMsg('W', ' 'SH_Ln)
ListHighlightData = 1
end
end
end
end
end
end
call close('DataFile')
end
if DoEaster == 1 then call AssignHighlight(SH_EasterMonth, SH_EasterDay, Easter$'#')
if sign(SH_Progress) == 1 then call UpdateBusy(Req, -SH_Progress)
SettingHighlights = 0
return
/**/
/***//******* Syntax () Subroutine ***********/
Syntax:
signal off syntax
ErrorLine = SIGL
SourceLine = strip(SourceLine(ErrorLine))
call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
call AddMsg('E', ParseVariables(SourceLine))
call Cleanup
exit
/**/
/***//******* UpdateBusy (UB) Subroutine ***********/
UpdateBusy:
parse arg UB_ReqWin, UB_ProgressMade
if UB_ReqWin == 0 then return
Progress = Progress + UB_ProgressMade
call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup
return
/**/
/***//******* VIO Routines () Subroutine ***********/
/***//** OpenV() **/
OpenV:
parse arg VIO_Variable
if Open.VIO_Variable ~= 1 then do
Open.VIO_Variable = 1
Pointer.VIO_Variable = 1
EOF.VIO_Variable = 0
return 1
end
else return 0
/**/
/***//** CloseV() **/
CloseV:
parse arg VIO_Variable
If Open.VIO_Variable == 0 then return 0
Open.VIO_Variable = 0
return 1
/**/
/***//** SeekV() **/
SeekV:
parse arg VIO_Variable, VIO_Offset, VIO_Anchor
if Open.VIO_Variable == 1 then do
VIO_Anchor = upper(left(VIO_Anchor, 1))
VIO_Value = Value(VIO_Variable)
select
when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
end
if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
if Pointer.VIO_Variable == 0 then Pointer.VIO_Variable = 1
return Pointer.VIO_Variable
end
else return 0
/**/
/***//** ReadVCh() **/
ReadVCh:
parse arg VIO_Variable, VIO_Length
if VIO_Length == '' then VIO_Length = 1
if Open.VIO_Variable == 1 then do
if EOF.VIO_Variable == 0 then do
VIO_Value = Value(VIO_Variable)
VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
else EOF.VIO_Variable = 0
end
else VIO_Ret = ''
end
else VIO_Ret = ''
return VIO_Ret
/**/
/***//** ReadVLn(RV) **/
ReadVLn:
parse arg VIO_Variable, VIO_Count, VIO_SepChar
if VIO_Count == '' then VIO_Count = 1
if VIO_SepChar == '' then VIO_SepChar = '0a'x
if Open.VIO_Variable == 1 then do
VIO_Value = Value(VIO_Variable)
VIO_Ret = ''
do VIO_i = 1 to VIO_Count
VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
if VIO_LF > 0 then do
VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
Pointer.VIO_Variable = VIO_LF + 1
if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
else EOF.VIO_Variable = 0
end
else do
if Pointer.VIO_Variable < length(VIO_Value) then do
VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
Pointer.VIO_Variable = length(VIO_Value) + 1
EOF.VIO_Variable = 1
end
end
if EOF.VIO_Variable == 1 then leave
if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
end
end
else VIO_Ret = ''
return VIO_Ret
/**/
/***//** WriteVCh() **/
WriteVCh:
parse arg VIO_Variable, VIO_String, VIO_Option
VIO_Value = Value(VIO_Variable)
VIO_Option = upper(left(VIO_Option, 1))
VIO_Length = length(VIO_Value)
if VIO_Option == 'C' then do
VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
end
else if VIO_Option == 'B' then do
VIO_Value = VIO_String''VIO_Value
Pointer.VIO_Variable = length(VIO_String) + 1
end
else do
VIO_Value = VIO_Value''VIO_String
Pointer.VIO_Variable = length(VIO_Value)
end
interpret VIO_Variable'= VIO_Value'
if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
else VIO_Ret = 0
return VIO_Ret
/**/
/***//** WriteVLn() **/
WriteVLn:
parse arg VIO_Variable, VIO_String, VIO_Option
return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
/**/
/***//** EOFV() **/
EOFV:
parse arg VIO_Variable
if Open.VIO_Variable == 1 then return EOF.VIO_Variable
else return 1
/**/
/**/
/***//******* WriteData (WD) Subroutine ***********/
WriteData:
if open('DataFile', ScriptDir''ChangesFile, 'W') then do
call writeln('DataFile', 'Dataversion 'word(sourceline(4), 3))
call writeln('DataFile', "PrefsFile = '"PrefsFile"'")
do WD_i = 0 to RD_SL - 1
WD_VarName = RD_Var.WD_i
if upper(left(WD_VarName, pos('.', WD_VarName))) == 'IMAGECLASS.' then do
WD_IC = MemberID(upper(substr(WD_VarName, 12)), 'ImageClass')
WD_Value = ImageFile.WD_IC
end
else WD_Value = Value(WD_VarName)
if (datatype(WD_Value) == 'CHAR') then do
if pos("'", WD_Value) ~= 0 then WD_Value = '"'WD_Value'"'
else WD_Value = "'"WD_Value"'"
end
call writeln('DataFile', WD_VarName' = 'WD_Value)
end
call close('DataFile')
end
else do
call AddMsg('E', 'Unable to create 'ScriptDir''ChangesFile)
call Cleanup
end
return
/**/
/***//******* WriteEnv (WE) Subroutine ***********/
WriteEnv: PROCEDURE
parse arg file var
if open('Temp', 'ENV:'file, 'W') then call writech('Temp', var)
return close('Temp')
/**/
/***//******* InitializeVariables () Subroutine *********/
InitializeVariables:
ColorVars = 'color. line. background.'
CountJulian = 0
CountJulianLeft = 0
CountSunRise = 0
CountSunSet = 0
CountPhases = 0
Error = 0
esc = "1B"x
FSize. = 10
FWCData = 'FWCalendar.data'
ChangesFile = 'FWC.dat'
HighlightCount = 0
ImageClass.Count = 0
ImageCount = 0
ImageSize. = ''
ImageType. = ''
ImageWidth. = 0
ImageHeight. = 0
LF = '0a'x
MoonPhase. = ''
NULL = '00'x
OB_ProgressWindow = ''
PatVar = '#?.(data|prefs)'
Req = 0
Storage = 'RAM:FWC/'
Text. = ''
TextAdj = 0.77
TTextArea = 0.15
WTextArea = 0.20
UserPrefs = ''
Width. = 100
Spc =' '
NormalWidth.Spc = 0
BoldWidth.Spc = 0
PGSFilter. = ''
PGSFilter.ILBM = 'IFFILBM'
PGSFilter.JFIF = 'JPEG'
PGSFilter.POST = 'IllustratorEPS'
Action.0 = 'MX_EnableButton'
Action.1 = 'MX_DisableButton'
GroupCount = 4
pos.0 = 'BL' ; grp.0 = 'obj.bottomleft_'
pos.1 = 'BC' ; grp.1 = 'obj.bottomcenter_'
pos.2 = 'BR' ; grp.2 = 'obj.bottomright_'
pos.3 = 'TC' ; grp.3 = 'obj.topcenter_'
pos.4 = 'TR' ; grp.4 = 'obj.topright_'
Do.1 = 'Phases' ; MXPos.Phases = 1
Do.2 = 'Weeknumber' ; MXPos.Weeknumber = 2
Do.3 = 'Julian' ; MXPos.Julian = 3
Do.4 = 'JulianLeft' ; MXPos.JulianLeft = 4
Do.5 = 'BothJ' ; MXPos.BothJ = 5
Do.6 = 'Sunrise' ; MXPos.Sunrise = 6
Do.7 = 'Sunset' ; MXPos.Sunset = 7
Do.8 = 'BothS' ; MXPos.BothS = 8
if App == 'FW' then do
DefaultFont = 'SoftSans'
DefaultBold = 'SoftSans_Bold'
end
else if App == 'PGS' then do
DefaultFont = 'PageStream-Normal'
DefaultBold = 'PageStream-Normal'
end
Date = 0
Weekday = 1
Header = 2
MiniCal = 3
FYMiniCal = 4
Highlight = 5
Extras = 6
FontTypes = 6
D.0 = 'Sunday'
D.1 = 'Monday'
D.2 = 'Tuesday'
D.3 = 'Wednesday'
D.4 = 'Thursday'
D.5 = 'Friday'
D.6 = 'Saturday'
MonthLength.1 = 31
MonthLength.2 = 28
MonthLength.3 = 31
MonthLength.4 = 30
MonthLength.5 = 31
MonthLength.6 = 30
MonthLength.7 = 31
MonthLength.8 = 31
MonthLength.9 = 30
MonthLength.10 = 31
MonthLength.11 = 30
MonthLength.12 = 31
call TranslationStrings
return
/**/
/***//******* InitializeSettings Subroutine ***********/
InitializeSettings:
call GetLogInfo
if App == 'FW' then do
call open('FWPrefs', CurrentDir'FWFiles/FW.Prefs')
FWPrefs = readch('FWPrefs', 65535)
call close('FWPrefs')
ColorTable = pos('SWCL', FWPrefs) + 12
EndTable = pos('STUP', FWPrefs)
ColorCount = 0
Do CTPos = ColorTable to EndTable by 20
ColorRegister = c2x(substr(FWPrefs, CTPos - 3, 3))
ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
if ColorRegister = '000000' then Black$ = ColorList.ColorCount
if ColorRegister = 'FFFFFF' then White$ = ColorList.ColorCount
ColorCount = ColorCount + 1
end
ColorList.ColorCount = '<'Clear$'>'
ColorCount = ColorCount + 1
ColorList.COUNT = ColorCount
if symbol('Black$') == 'LIT' then do
call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
Black$ = ColorList.0
end
if symbol('White$') == 'LIT' then do
call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
White$ = ColorList.1
end
end
else if App == 'PGS' then do
GETFONTLIST FontList
FontList.COUNT = result
call open('PGSColors', CurrentDir''word(PgmVersion, 1)'.colors')
PGSColors = readch('PGSColors', 65535)
call close('PGSColors')
ColorCount = 0
StartTag = pos('TG'||'00'x, PGSColors)
do while StartTag ~= 0
Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
AccentMarker = pos(d2c(129), Color)
do while AccentMarker > 0
Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
AccentMarker = pos(d2c(129), Color)
end
ColorList.ColorCount = Color
ColorCount = ColorCount + 1
StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
end
ColorList.ColorCount = '<'Clear$'>'
ColorCount = ColorCount + 1
ColorList.COUNT = ColorCount
White$ = ColorList.0
Black$ = ColorList.1
end
DefaultColor = Black$
DefaultBackground = White$
RequesterVariables = 1
if App == 'PGS' then do
GETDOCUMENTS dummy; DocCount = result
if DocCount > 0 then do
call bguireq('1b'x||"cYou "||'1b'x||"bmust"||'1b'x||"-b close all other",
||'0a'x||"documents before using FWCalendar.","*"OK$,'',,PubScreen)
call CleanUp
end
end
VarLoc = VarListLoc()
return
/**/
/***//******* SetVariables Subroutine ***********/
SetVariables:
CNotice = 'Created w/ FWCalendar © Ron Goertz'
FSize.4pt = 4
Font.4pt = DefaultFont
DoJulian = upper(DoJulian)
DoJulianLeft = upper(DoJulianLeft)
ShiftLMini = ShiftLMini / 720
ShiftRMini = ShiftRMini / 720
if (PhaseLib ~= 1) & (DoPhases ~= 0) then do
call AddMsg('W', 'date.library or rexxmathlib.library are required to calculate the moon phases.')
DoPhases = 0
end
do i = 0 to 6
val = i - StartWeek
if val < 0 then val = 7 + val
interpret 'Day.'D.i '=' val
interpret 'Day.val = 'D.i'$'
end
if App == 'FW' then do
TextBase = TextAdj
do i = 0 to FontTypes
if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
if ~exists(Font.i) then do
call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
Font.i = DefaultFont
end
end
if Bold.MiniCal == NameOnly(Bold.MiniCal) then Bold.MiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.MiniCal
if ~exists(Bold.MiniCal) then do
call AddMsg('W', NameOnly(Bold.MiniCal)" can't be found; "DefaultBold" used instead.")
Bold.MiniCal = DefaultBold
end
if Bold.FYMiniCal == NameOnly(Bold.FYMiniCal) then Bold.FYMiniCal = CurrentDir'FWFonts/SWOLFonts/'Bold.FYMiniCal
if ~exists(Bold.FYMiniCal) then do
call AddMsg('W', NameOnly(Bold.FYMiniCal)" can't be found; "DefaultBold" used instead.")
Bold.FYMiniCal = DefaultBold
end
PAGESETUP ORIENT Orientation
if upper(Orientation) == 'WIDE' then TextArea = WTextArea
else TextArea = TTextArea
GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
DISPLAYPREFS Measure Inches
SECTIONSETUP TOP Margin.Top BOTTOM Margin.Bottom INSIDE Margin.Left OUTSIDE Margin.Right
GETPAGESETUP Width Height
parse var result FullWidth FullHeight
end
else if App = 'PGS' then do
TextBase = 1
do i = 0 to FontTypes
do j = 0 to FontList.COUNT - 1
if upper(Font.i) == upper(FontList.j) then leave
end
if j == FontList.COUNT then do
call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
Font.i = DefaultFont
end
end
do j = 0 to FontList.COUNT - 1
if upper(Bold.MiniCal) == upper(FontList.j) then leave
end
if j == FontList.COUNT then do
call AddMsg('W', Bold.MiniCal" can't be found; "DefaultBold" used instead.")
Bold.MiniCal = DefaultBold
end
do j = 0 to FontList.COUNT - 1
if upper(Bold.FYMiniCal) == upper(FontList.j) then leave
end
if j == FontList.COUNT then do
call AddMsg('W', Bold.FYMiniCal" can't be found; "DefaultBold" used instead.")
Bold.FYMiniCal = DefaultBold
end
if upper(Orientation) == 'WIDE' then do
TextArea = WTextArea
Orientation = 'LANDSCAPE'
end
else do
TextArea = TTextArea
Orientation = 'PORTRAIT'
end
if CalType == 1 then DocName = '"'EnteredYear''Mn''Calendar$'"'
else DocName = '"'EnteredYear''Calendar$'"'
PageName = '"FWCalendar by Ron Goertz"'
NEWDOCUMENT DocName
NEWMASTERPAGE PageName PageWidth PageHeight SINGLE Orientation
SETMARGINGUIDES Margin.Left Margin.Right Margin.Top Margin.Bottom MASTERPAGE PageName
SETDIMENSIONS PageWidth PageHeight SINGLE Orientation MASTERPAGE PageName
SETCOLUMNGUIDES 0 0 MASTERPAGE PageName
SETDOCUMENTSTATUS unchanged DOCUMENT DocName
OPENWINDOW '"View 1"' DOCUMENT DocName PAGE 1
GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
GETMARGINGUIDES temp MASTERPAGE PageName
if rc == 0 then do
Margin.Left = temp.inside
Margin.Right = temp.outside
Margin.Top = temp.top
Margin.Bottom = temp.bottom
end
GETDIMENSIONS temp MASTERPAGE PageName
CmdSuccess = rc
if Orientation = 'LANDSCAPE' then do
if CmdSuccess == 0 then do
FullWidth = temp.height
FullHeight = temp.width
end
else do
FullWidth = PageHeight
FullHeight = PageWidth
end
end
else do
if CmdSuccess == 0 then do
FullWidth = temp.width
FullHeight = temp.height
end
else do
FullWidth = PageWidth
FullHeight = PageHeight
end
end
CURRENTWINDOW; winName = '"'RESULT'"'
end
PrintWidth = FullWidth - Margin.Left - Margin.Right
PrintHeight = FullHeight - Margin.Top - Margin.Bottom
if CalType == 1 then do
Height.4pt = GetHeight(4pt)
if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then do
DoCopyright = 1
PrintHeight = PrintHeight - Height.4pt
end
else DoCopyright = 0
BoxWidth = PrintWidth/7
CalRight = Margin.Left + BoxWidth * 7
TextArea = TextArea * PrintHeight
CalTop = TextArea + Margin.Top
BoxHeight = (PrintHeight - TextArea)/5
MoonRadius = BoxHeight * MoonRadius
DateOffset = DateOffset * BoxWidth
MiniCalHeight = TextArea * MiniCalHeight
MiniCalWidth = MiniCalHeight * MiniCalWidth
FSize.Highlight = BoxHeight/HighlightRows * 72
FSize.Extras = FSize.Highlight * MagnifyExtras
FSize.Date = BoxHeight/HighlightRows * 72 * StretchDateH
Width.Date = 100 * StretchDateW / StretchDateH
FSize.Weekday = (TextArea - MiniCalHeight) * WeekdaySize * 72
FSize.Header = TextArea * HeaderSize * 72
if App == 'FW' then do
FSize.MiniCal = MiniCalHeight/6 * 72
do i = 0 to 6
FSize.i = min(max(trunc(FSize.i), 4), 360)
Width.i = min(max(trunc(Width.i), 4), 255)
end
end
else if App == 'PGS' then FSize.MiniCal = MiniCalHeight/7 * 72
Height.Highlight = FSize.Highlight / 4 * Height.4pt * Leading/100
Height.Date = FSize.Date / 4 * Height.4pt * Leading/100
Height.Weekday = FSize.Weekday / 4 * Height.4pt * Leading/100
Height.Header = FSize.Header / 4 * Height.4pt * Leading/100
Height.MiniCal = FSize.MiniCal / 4 * Height.4pt * Leading/100
Height.Extras = FSize.Extras / 4 * Height.4pt * Leading/100
if DoMiniCals == 1 then call GetMiniMax(MiniCal)
end
else do
Height.4pt = GetHeight(4pt)
if ((((PrintHeight - (3 * MiniCalSpacing) - Height.4pt) / 4 ) / 7) * 72) >= 4 then DoCopyright = 1
else DoCopyright = 0
MiniCalSpacing = PrintWidth * MiniCalSpacing
MiniCalWidth = (PrintWidth - 2 * MiniCalSpacing)/3
FSize.FYMiniCal = (((PrintHeight - (3 * MiniCalSpacing) - (Height.4pt * DoCopyright)) / 4 ) / 7) * 72
if App == 'FW' then FSize.FYMiniCal = max(trunc(FSize.FYMiniCal), 4)
Height.FYMiniCal = FSize.FYMiniCal / 4 * Height.4pt * Leading/100
call GetMiniMax(FYMiniCal)
end
if App == 'FW' then do
FIRSTOBJECT; ObjID = result
SELECTOBJECT ObjID
do forever
NEXTOBJECT ObjID; ObjID = result
if ObjID == 0 then leave
SELECTOBJECT ObjID MULTIPLE
end
DELETEOBJECT
end
VariablesSet = 1
if ErrorCount > 0 then call Cleanup
return
/**/
/***//******* TranslationStrings () Subroutine ***********/
TranslationStrings:
Backgrounds$ = 'Backgrounds'
Bottom$ = 'Bottom'
BoxColor$ = 'Box:'
BoxDates$ = 'Box Dates'
Boxed$ = '_Boxed:'
Calendar$ = 'Calendar'
Cancel$ = '_Cancel'
CantFind$ = "can't be found"
CantMatch$ = "The export file can't be the"||'0a'x||"same as the preferences file"
CantOpen$ = "can't be opened"
Center$ = 'Center'
Clear$ = 'Clear'
Colors$ = 'Colors'
Critical$ = 'Critical error'
DailyColors$ = 'Use daily colors'
Easter$ = 'Easter'
End$ = 'End:'
EnterEvent$ = 'You must enter an event...'
EnterEventInfo$ = 'Enter event information:'
EnterStartdate$ = 'You must enter a start date...'
Event$ = 'Event:'
Export$ = 'E_xport'
ExportFile$ = 'Select export file:'
Exporting$ = 'Exporting'
Extended$ = 'Extended'
File$ = 'File:'
Font$ = 'Font:'
Fonts$ = 'Fonts'
ForDetails$ = 'for details'
ForwardContent$ = 'Forward contents of output to'
ForwardLog$ = 'Forward log file to'
GeneratingM$ = 'Generating %s %s calendar'
GeneratingY$ = 'Generating %s calendar'
GenMVars = 'Month.Month EnteredYear'
GenYVars = 'EnteredYear'
Highlights$ = 'Highlights'
Images$ = 'Images'
Julian$ = 'Julian'
JulJulLeft$ = 'Jul/Jul Left'
JulLeft$ = 'Jul Left'
Left$ = 'Left'
Line$ = '_Line:'
Load$ = '_Load'
MatchColors$ = 'Date Color = Highlight Color'
MiniCals$ = 'MiniCals'
MiscVar$ = 'Miscellaneous Variables'
Monthly$ = '_Monthly'
MustUse$ = "You must use the gadget to"||'0a'x||"the right to select a font."
Noncritical$ = 'Noncritical warning'
None$ = 'None'
NotClear$ = '<'Clear$'> can only be used for "Background." variables...'
Notice$ = 'notice'
OK$ = '_OK'
Options$ = 'Options'
OptLayout$ = 'Options & Layout'
OrientMarg$ = 'Orientation & Margins'
Phases$ = 'Phases'
PleaseWait$ = 'Please wait'
PrepReq$ = 'Preparing requester'
ProcessEvents$ = 'Processing events'
Reset$ = '_Reset'
Right$ = 'Right'
RiseSet$ = 'Rise/Set'
See$ = 'see'
SeeOutput$ = 'see the output above for details'
SeeShell$ = 'see the shell output for details'
SelectFile$ = 'Select data file:'
SelectFont$ = 'Select font:'
Start$ = 'Start:'
Sunrise$ = 'Sunrise'
Sunset$ = 'Sunset'
Tall$ = 'Tall'
TextColor$ = 'Text:'
Top$ = 'Top'
Unable$ = 'if you are unable to resolve the problem.'
VarGUITitle$ = 'Set desired variables:'
Variables$ = 'Variables'
Weekly$ = '_Weekly:'
Weeknumber$ = 'Weeknumber'
WholeYear$ = 'Whole _Year'
Wide$ = 'Wide'
January$ = 'January'
February$ = 'February'
March$ = 'March'
April$ = 'April'
May$ = 'May'
June$ = 'June'
July$ = 'July'
August$ = 'August'
September$ = 'September'
October$ = 'October'
November$ = 'November'
December$ = 'December'
Sunday$ = 'Sunday'
Monday$ = 'Monday'
Tuesday$ = 'Tuesday'
Wednesday$ = 'Wednesday'
Thursday$ = 'Thursday'
Friday$ = 'Friday'
Saturday$ = 'Saturday'
return 0
/**/
/***//******* VarList () Subroutine ***********/
ReturnVarListLoc:
return SIGL + 2
VarListLoc:
/* WTextArea = fraction of print height used for top of calendar (Wide) */
/* TTextArea = fraction of print height used for top of calendar (Tall) */
/* DateOffset = fraction of box width to offset dates from edge of box */
/* MiniCalHeight = fraction of text area height used for minicals */
/* MiniCalWidth = width-to-height ratio for minicals */
/* MiniCalSpacing = fraction of print width placed between FY minicals */
signal ReturnVarListLoc
VarList:
AddEventRows = 9
AdjustDST = 1
AltColor.Date = Black$
AltColor.Extended = Black$
AltColor.Highlight = Black$
AltColor.HighlightH = Black$
AltColor.Julian = Black$
AltColor.Sunrise = Black$
AltColor.Sunset = Black$
AltColor.WeekNumber = Black$
Background.AddEvent = White$
Background.Highlight = White$
Background.HighlightH = White$
Background.MiniCal = White$
Background.Weekend = White$
BelzierFactor = .55
Bold.MiniCal = DefaultBold
Bold.FYMiniCal = DefaultBold
CenterMiniDates = 1
Color.Sunday = Black$
Color.Monday = Black$
Color.Tuesday = Black$
Color.Wednesday = Black$
Color.Thursday = Black$
Color.Friday = Black$
Color.Saturday = Black$
Color.AddEvent = Black$
Color.Date = Black$
Color.Extended = Black$
Color.Header = Black$
Color.Highlight = Black$
Color.HighlightH = Black$
Color.Julian = Black$
Color.MiniCal = Black$
Color.Moon = Black$
Color.Sunrise = Black$
Color.Sunset = Black$
Color.Weekday = Black$
Color.WeekNumber = Black$
DateOffset = 0.02
DoBackgrounds = 0
DoDailyColors = 0
DoDateBox = 0
DoEaster = 1
DoExtended = 1
DoHide = 0
DoHighlights = 0
DoImages = 0
DoJulian = 0
DoJulianLeft = 0
DoMatchColors = 0
DoMiniCals = 1
DoPhases = 0
DoShanghai = 1
DoSunRise = 0
DoSunSet = 0
DoWeekNumber = 0
FinalView = 75
Font.Date = DefaultFont
Font.Extras = DefaultFont
Font.Header = DefaultFont
Font.Highlight = DefaultFont
Font.MiniCal = DefaultFont
Font.FYMiniCal = DefaultFont
Font.Weekday = DefaultFont
GfxApp = 'Visage'
GfxAppPath = ''
GfxCmd = '%s info'
GfxTemplate = '. "0a"x . ImgDT ImgWidth "x" ImgHeight "x" .'
HeaderLoc = 2
HeaderSize = .5
HighlightRows = 9
LaunchM = ''
LaunchY = ''
Leading = 100
Line.AddEvent = Black$
Line.Extended = Black$
Line.Grid = Black$
Line.MiniCal = Black$
MagnifyExtras = 1
Margin.Bottom = 0
Margin.Left = 0
Margin.Right = 0
Margin.Top = 0
MinWidth = 80
MaxImgHeight = .75
MaxImgWidth = .75
MiniCalHeight = 0.60
MiniCalSpacing = 0.005
MiniCalWidth = 2.00
MoonRadius = .1
Orientation = 'Wide'
PrefsName = ''
ShiftLMini = 0
ShiftRMini = 0
StartWeek = 0
StretchDateH = 1
StretchDateW = 1
SunCalcPath = ''
Text.Julian = ''
Text.Sunrise = ''
Text.Sunset = ''
Text.WeekNumber = ''
WeekdaySize = .5
return
/**/